محتويات المقاصة

أنا أستخدم الكود التالي المذكور أدناه. أنا أعمل بشكل جيد، لكنه يمسح التركيبة الموجودة في إحدى خلاياي. كيف يمكنني تعديل هذا الرمز لتخطي خلية واحدة في ورقتي؟

Sub MoveRowBasedOnCellValue ()
'تم التحديث بواسطة Extendoffice 2017/11/10
خافت xRg كمدى
خافت xCell كمجموعة
خافت أنا طويلة
خافت J بطول
خافت K وطولها
i = أوراق العمل("البيانات").UsedRange.Rows.count
J = أوراق العمل ("مكتملة").UsedRange.Rows.count
إذا كان J = 1 ثم
إذا كان Application.WorksheetFunction.CountA(Worksheets("Completed").UsedRange) = 0 ثم J = 0
إنهاء حالة
تعيين xRg = أوراق العمل("البيانات").Range("A1:A" & i)
على خطأ استئناف التالي
Application.ScreenUpdating = خطأ
بالنسبة لـ K = 1 إلى xRg.count
إذا كان CStr(xRg(K).Value) = "مكتمل" إذن
xRg(K).EntireRow.Copy Destination:=Worksheets("Completed").Range("A" & J + 1)

xRg(K).EntireRow.ClearContents


ي = ي + 1
إنهاء حالة
التالى
Application.ScreenUpdating = ترو
الأعمدة("أ:أ").حدد
ActiveWorkbook.Worksheets("البيانات").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Data").Sort.SortFields.Add2 Key:=Range("A3:A16") _
، SortOn:=xlSortOnValues، الترتيب:=xlتصاعدي، DataOption:=xlSortNormal
مع ActiveWorkbook.Worksheets("البيانات").فرز
نطاق SetRange("A2:Q16")
.الرأس = xlYes
.MatchCase = خطأ
.الاتجاه = xlTopToBottom
.SortMethod = xlPinYin
.يتقدم
Application.Goto Reference:=Worksheets("Data").Range("A3")
انتهت ب