İki tarih arası rapor alma

[ozuberk]

Merhaba arkadaşlar,

İki tarih arası ve açıklamaya göre rapor almak istiyorum. Yardımcı olacak arkadaşlar şimdiden teşekkür ederim.

Kolay gelsin.

 

[Orion1]

Dosyanız ektedir.

Sub tarihe_gore_rapor_59()
Dim sat As Long, sh As Worksheet
Set sh = Sheets("Sayfa2")
Sheets("Sayfa1").Select
sh.Range("A3:D" & Rows.Count).Clear
Range("A7:D7").AutoFilter
Range("A7:D7").AutoFilter field:=1, Criteria1:=">=" & _
        CLng(Cells(3, "C").Value), Operator:=xlAnd, Criteria2:="<=" & _
        CLng(Cells(3, "D").Value)
Range("A7").CurrentRegion.Copy sh.Range("A2")
Range("A7:D7").AutoFilter
sh.Select
Set sh = Nothing
MsgBox "Rapor Çıkarıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub
Sub aciklamaya_gore_rapor_59()
Dim sat As Long, sh As Worksheet
Set sh = Sheets("Sayfa2")
Sheets("Sayfa1").Select
sh.Range("A3:D" & Rows.Count).Clear
Range("A7:D7").AutoFilter
Range("A7:D7").AutoFilter field:=2, Criteria1:=Cells(4, "C").Value
Range("A7").CurrentRegion.Copy sh.Range("A2")
Range("A7:D7").AutoFilter
sh.Select
Set sh = Nothing
MsgBox "Rapor Çıkarıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[ozuberk]

Hocam elinize sağlık çok güzel olmuş. Raporu başka sayfaya kopyalamadan aynı sayfada uygulamak mümkün müdür?

 

[Orion1]

Hocam elinize sağlık çok güzel olmuş. Raporu başka sayfaya kopyalamadan aynı sayfada uygulamak mümkün müdür?

Dosyanız ektedir.

Sub tarihe_gore_rapor_59()
Dim sat As Long, sh As Worksheet
'Set sh = Sheets("Sayfa2")
Sheets("Sayfa1").Select
'sh.Range("A3:D" & Rows.Count).Clear
Application.ScreenUpdating = False
Range("A7:D7").AutoFilter
Range("A7:D7").AutoFilter field:=1, Criteria1:=">=" & _
        CLng(Cells(3, "C").Value), Operator:=xlAnd, Criteria2:="<=" & _
        CLng(Cells(3, "D").Value)
'Range("A7").CurrentRegion.Copy sh.Range("A2")
'Range("A7:D7").AutoFilter
'sh.Select
'Set sh = Nothing
Application.ScreenUpdating = True
MsgBox "Rapor Çıkarıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub
Sub aciklamaya_gore_rapor_59()
Dim sat As Long, sh As Worksheet
'Set sh = Sheets("Sayfa2")
Sheets("Sayfa1").Select
'sh.Range("A3:D" & Rows.Count).Clear
Application.ScreenUpdating = False
Range("A7:D7").AutoFilter
Range("A7:D7").AutoFilter field:=2, Criteria1:=Cells(4, "C").Value
'Range("A7").CurrentRegion.Copy sh.Range("A2")
'Range("A7:D7").AutoFilter
'sh.Select
'Set sh = Nothing
Application.ScreenUpdating = True
MsgBox "Rapor Çıkarıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[ozuberk]

Hocam teşekkürler, kolay gelsin.