السلام عليكم
جرب هذا الكود
CODE
Sub Test()
Dim x, ws As Worksheet, sh As Worksheet, nInvoice, r As Long, n As Long
Application.ScreenUpdating = False
Set ws = ThisWorkbook.Worksheets(1)
Set sh = ThisWorkbook.Worksheets(2)
nInvoice = sh.Range("B3").Value
x = Application.Match(nInvoice, ws.Columns(1), False)
n = 7
If Not IsError(x) And nInvoice <> Empty Then
For r = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row
If ws.Cells(r, 1).Value = nInvoice Then
sh.Cells(n, 1).Resize(1, 4).Value = ws.Cells(r, 4).Resize(1, 4).Value
n = n + 1
End If
Next r
End If
Application.ScreenUpdating = True
MsgBox "Done...", 64
End Sub
نسخ و طباعة نطاق معين بشرط او اكثر
