Süzme makrosu çalışmıyor

[ockucukay]

Merhaba Arkadaşlar

Örnekleri karıştırdım biraz ve bu kodu kendime uyarladım. 1.ve 2.tarih seçildikten sonra listeyi süz düğmesini tıkladığımda, listeyi süzerek "Listele" sayfasına kopyalasın istiyorum, ama süzdürme işleminde hata veriyor, nasıl yapabilirim?


Private Sub CommandButton1_Click()
If DTPicker1.Value = "" Then
MsgBox "İlk Tarih Mutlaka Girilmelidir...", vbCritical, "İlk Tarih"
Exit Sub
ElseIf DTPicker2.Value = "" Then
MsgBox "Son Tarih Mutlaka Girilmelidir...", vbCritical, "Son Tarih"
Exit Sub
End If
Sheets("Listele").Range("A165536").ClearContents
ilk = Sheets("DATABASE").Range("R1")
iki = Sheets("DATABASE").Range("S1")
Sheets("DATABASE").Select
For x = 2 To 65536
son = [g65536].End(3).Row + 1
If CDate(Cells(x, 1)) >= ilk And CDate(Cells(x, 1)) <= iki Then ' Burada hata veriyor
Sheets("Listele").Range("A" & son).Value = Sheets("DATABASE").Range("a" & x).Value
Sheets("Listele").Range("B" & son).Value = Sheets("DATABASE").Range("b" & x).Value
Sheets("Listele").Range("C" & son).Value = Sheets("DATABASE").Range("c" & x).Value
Sheets("Listele").Range("D" & son).Value = Sheets("DATABASE").Range("d" & x).Value
Sheets("Listele").Range("E" & son).Value = Sheets("DATABASE").Range("e" & x).Value
Sheets("Listele").Range("F" & son).Value = Sheets("DATABASE").Range("f" & x).Value
Sheets("Listele").Range("G" & son).Value = Sheets("DATABASE").Range("g" & x).Value
Sheets("Listele").Range("H" & son).Value = Sheets("DATABASE").Range("h" & x).Value
Sheets("Listele").Range("I" & son).Value = Sheets("DATABASE").Range("ı" & x).Value
Sheets("Listele").Range("J" & son).Value = Sheets("DATABASE").Range("j" & x).Value
Sheets("Listele").Range("K" & son).Value = Sheets("DATABASE").Range("k" & x).Value
Sheets("Listele").Range("L" & son).Value = Sheets("DATABASE").Range("l" & x).Value
Sheets("Listele").Range("M" & son).Value = Sheets("DATABASE").Range("m" & x).Value
Sheets("Listele").Range("N" & son).Value = Sheets("DATABASE").Range("n" & x).Value
Sheets("Listele").Range("O" & son).Value = Sheets("DATABASE").Range("o" & x).Value
Sheets("Listele").Range("P" & son).Value = Sheets("DATABASE").Range("p" & x).Value
ListBox1.RowSource = "Listele!A165536"
ListBox1.ColumnCount = 16
ListBox1.ColumnHeads = False
End If
Next
End Sub

 

[ASMET67]

dosyanızı eklerseniz daha rahat çözüm bulursunuz.

 

[ockucukay]

Özür dilerim eklememişim, şimdi ekledim. Yardımlarınız için şimdiden teşekkür ederim.

 

[ockucukay]

arkadaşlar bir fikri olan yok mu acaba?

 

[ockucukay]

bu konu hakkında son yardım çağrım olacak, lütefen arkadaşlar hala bulamadım.