ارجو من حضراتكم مساعدتى فى كود الترحيل

[محمد فاروق محمود]

مشكلة فى كود ترحيلBook1.rar

[احمد عبد الناصر]

السلام عليكم

جرب هذا الكود اتمنا ان يكون ما قصدت

Book1+.rar

تم تعديل ديسمبر 15, 2012 بواسطه احمد عبد الناصر

[الـعيدروس]

الكود ينقصه اغلاق الشرط If بـ End if

وحلقة التكرار بـ Next

ونهاية الكود بـ End sub

ليكون كالتالي

Sub a()

Dim cl As Range

If [b1] = "" Then Exit Sub

For Each cl In Range("b3:b" & [b1000].End(xlUp).Row)

If cl.Value < 5000 Then

Sheets("a").Range("a" & Sheets("a").[a1000].End(xlUp).Row + 1) = cl.Offset(0, -1)

Sheets("a").Range("b" & Sheets("a").[b1000].End(xlUp).Row + 1) = cl.Offset(0, 1)

End If

Next

End Sub

[أبو حنــــين]

بعد إذن الإخوة جرب المرفق

Book1111.rar

[محمد فاروق محمود]

اشكركم جميعا وفعلاً وجدت ما اريد