تعديل كود

[ام بسمه]

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 وانا عايزة الشيتين يبداؤ من اول صف بداية الكشف

[ام بسمه]

للرفع

[أبو محمد عباس]

السلام عليكم ورحمة الله وبركاته

الاخت الفاضله ام بسمه بارك الله فيك

الافضل ارفاق ملف اكسل وفيه بيانات وهمية ومقاربة لعملك المطلوب وفيه شرح بسيط حتى يتسنى للاساتذة الكرام معرفة المطلوب

وان شاء الله ستكون هناك اكثر من اجابة

تقبلي فائق الاحترام والتقدير