تعديل كود الترحيل بشرط

[طالب مدرسة أوفيسنا]

المطلوب تعديل بستبدال خلية الشرط G1  بكلمة "تنفيذ" بمعنى يبحث داخل العمود اذا وجد كلمة "تنفيذ" يرحل

الكود يعمل بشكل جيد مع البيانات القليله ولما اضع تقريبا 3000 صف الكود لاينفذ ويعطي مسج تم الترحيل وهو غير صحيح

اعتقد بناء الكود بشكل مختلف يحل المشكله مع الشكر

Dim Cl As Range

If [G1] = "" Then Exit Sub
For Each Cl In Range("O21:O" & [O6000].End(xlUp).Row)
If Cl.Value = [G1] Then
Cl.Offset(0, -14).Resize(1, 7).Copy
Range("R" & [R6000].End(xlUp).Row + 1).PasteSpecial xlPasteValues
End If
Next
MsgBox "تم الترحيل بنجاح ", vbOKOnly, "تنبيه"
End Sub

تم تعديل أبريل 22, 2015 بواسطه x8.

[ياسر خليل أبو البراء]

بدون ملف مرفق يصعب فهم المشكلة ..

ارفق الملف الذي به عدد الصفوف بالكامل للوقوف على المشكلة بشكل أدق