السلام عليكم و رحمة الله وبركاته
بعد الشكر و التقدير لأخي الفاضل ابو حنين على الكود الجميل
جزاه الله كل خير
اخي انس حل آخر
Dim FS As Worksheet, TS As Worksheet, RN1 As Range, ER, TR, T, R
Set FS = Sheets("Payment")
Set TS = Sheets("Cleared Payment")
'For R = 8 To Application.CountA(Range("au8:au5000"))
ER = Application.CountA(FS.Range("C1:C55555")) + 9
TR = Application.CountA(TS.Range("A1:A55555")) + 5
For R = 5 To ER
If FS.Range("U" & R) = 0 Then
Set RN1 = FS.Range("A" & R & ":S" & R)
RN1.Copy
TS.Range("A" & TR).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
RN1.ClearContents
TR = TR + 1
End If
Next R
Application.CutCopyMode = False
Set RN1 = FS.Range("A5:U" & ER)
RN1.Sort Key1:=Range("C5")
نقل بيانات المدفوعات المسدده.rar