Yazılan tarih uygun kayıtları aktarmak.

[webuyeislemleri]

F1 yazılan tarih ilk ve son tarih aralığına denk gelen kayıtları
Rapor sayfasına yazmak istiyorum.

Sub Aktar()
Application.ScreenUpdating = False
Dim sh As Worksheet
Dim sh2 As Worksheet
Set s1 = Sheets("Kayıt Listesi")
Set s2 = Sheets("Rapor")

Dim Bastarih As Date
Dim Bittarih As Date

Bastarih = [F1].Value
Bittarih = [F1].Value '[G1].Value

For i = 2 To s1.[B65536].End(3).Row
If Format(s1.Cells(i, "B").Value, "dd.mm.yyyy") >= CDate(Bastarih) Or Format(s1.Cells(i, "C").Value, "dd.mm.yyyy") <= CDate(Bittarih) Then
ss = s2.[G65536].End(3).Row + 1
s1.Rows(i).Copy s2.Rows(ss)
End If
Next

Application.ScreenUpdating = True
MsgBox "Aktarma işlemi tamamlanmıştır.", vbInformation
End Sub