tarih aralığı rapor alma

[zehfeysal]

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("ı3")) Is Nothing Then Exit Sub
CommandButton1_Click
End Sub
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
s4 = "GELİR"
Range("G125000").ClearContents
sat = 12
For i = 2 To Sheets(s4).[B65536].End(3).Row
If Range("ı3") = Sheets(s4).Cells(i, "b") Then
Cells(sat, "g") = sat - 11
Cells(sat, "h") = Sheets(s4).Cells(i, "b")
Cells(sat, "I") = Sheets(s4).Cells(i, "c")
Cells(sat, "k") = Sheets(s4).Cells(i, "d")
Cells(sat, "l") = Sheets(s4).Cells(i, "e")
Cells(sat, "m") = Sheets(s4).Cells(i, "g")
Cells(sat, "n") = Sheets(s4).Cells(i, "f")
sat = sat + 1
Else: End If
Next i
Range("ı3").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

bu kodla gelir sayfasındaki veri girişlerini kişi bazlı süzüyorum koda kişi bazlı ve tarih aralıgı verilerileri süzme imkanımız olurmu I8 sHücresi baslangıç tarihi I9 hücresi bitiş tarihi

 

[askm]

Kodları aşağıdaki şekilde revize edin.

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Dim s4 As Worksheet
Set s4 = Sheets("GELİR")
Range("G12:o5000").ClearContents
BasT = Range("I8")
BitT = Range("I9")
sat = 12
For i = 2 To s4.[B65536].End(3).Row
    If Range("ı3") = s4.Cells(i, "b") And BasT <= s4.Cells(i, 5) And BitT >= s4.Cells(i, 5) Then
        Cells(sat, "g") = sat - 11
        Cells(sat, "h") = s4.Cells(i, "b")
        Cells(sat, "I") = s4.Cells(i, "c")
        Cells(sat, "k") = s4.Cells(i, "d")
        Cells(sat, "l") = s4.Cells(i, "e")
        Cells(sat, "m") = s4.Cells(i, "g")
        Cells(sat, "n") = s4.Cells(i, "f")
        sat = sat + 1
    End If
Next i
Range("ı3").Select
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[zehfeysal]

tesekkurler