Sub Macro1()
Dim iNm As String
Dim Lr As Long, i As Long
Dim R As Integer
Dim d1 As Double, d2 As Double
iNm = Range("B1").Value
d1 = Range("B2").Value2
d2 = Range("B3").Value2
Range("D5:L300").ClearContents
Application.ScreenUpdating = False
With Sheet4
Lr = .Cells(.Rows.Count, "M").End(xlUp).Row
For i = 4 To Lr
If iNm = CStr(.Cells(i, "M")) Then
Select Case .Cells(i, "H").Value2
Case d1 To d2
R = R + 1
Cells(R + 4, "C").Value = R
Cells(R + 4, "G").Resize(1, 4).Value = .Cells(i, "H").Resize(1, 4).Value
Cells(R + 4, "D").Value = .Cells(i, "B").Value
Cells(R + 4, "E").Value = .Cells(i, "C").Value
Cells(R + 4, "F").Value = .Cells(i, "D").Value
Cells(R + 4, "H").Value = .Cells(i, "L").Value
End Select
End If
Next
With Sheet6
Lr = .Cells(.Rows.Count, "M").End(xlUp).Row
For i = 4 To Lr
If iNm = CStr(.Cells(i, "M")) Then
Select Case .Cells(i, "O").Value2
Case d1 To d2
R = R + 1
Cells(R + 4, "K").Value = .Cells(i, "N").Value
Cells(R + 4, "L").Value = .Cells(i, "O").Value
End Select
Application.ScreenUpdating = True
End If
Next
End With
End With
End Sub
ممكن تعديل هذا الكود من حيث التسلسل لان مصدر البيانات sheet4&sheet6 وفى كشف الحساب يكمل تسلسل شيت6 بعد شيت4 وانا عايزة الشيتين يبداؤ من اول صف بداية الكشف