Verileri listwıevde 2 tarih ve d sütununa göre listelemek

[MUTLUXXX]

Arkadaşlar aşağıdaki dosyada verileri sayfa1 de 2 tarih aralığına göre F,G,H,E Sütunlarındaki verileri birleştirerek bu verilere göre toplam alıyor sayfa2 de alınan toplamları verilere göre listeliyor ve listwiev de görüntülüyorum.Tarih aralığını Dtpickerden seçiyorum ve veri aralığına göre toplayarak listeliyorum.Daha sonrada commandbutton1 den call liste diyerek verileri listwıevde ekrana getiriyorum.Sorunum şu verileri 2 DTpickerden seçtiğim tarih aralığı ,veri ve d sütunundaki vardiyalara yani a,b,c,d vardiyalarına göre listelemek.Yani veriyi 2 tarih aralığı ve D sütunundaki vardiyalara göre ayrı ayrı liswıevde görüntüleyecek.Tşk ediyorum.
Sub sayfaya_listele()

Dim sat As Long, veri As String, k As Range, s1 As Worksheet, i As Long
Set s1 = Sheets("Sayfa1")
sat = 2
Sheets("Sayfa2").Range("A2:BK6553").ClearContents
For i = 3 To Sheets("Sayfa1").Cells(6553, "A").End(xlUp).Row
If s1.Cells(i, "A").Value >= DTPicker1.Value _
And s1.Cells(i, "A").Value <= DTPicker2.Value Then
veri = s1.Cells(i, "F").Value & "x" & s1.Cells(i, "G").Value _
& "x" & s1.Cells(i, "H").Value & "x" & s1.Cells(i, "E").Value
If WorksheetFunction.CountIf(Sheets("Sayfa2").Range("A1:A65536"), veri) = 0 Then
Sheets("Sayfa2").Cells(sat, "A").Value = veri
Sheets("Sayfa2").Cells(sat, "B").Value = s1.Cells(i, "I").Value
Sheets("Sayfa2").Cells(sat, "C").Value = s1.Cells(i, "J").Value
Sheets("Sayfa2").Cells(sat, "D").Value = s1.Cells(i, "K").Value
sat = sat + 1
Else
Set k = Sheets("Sayfa2").Range("A1:A6553").Find(veri, , xlValues, xlWhole)
If Not k Is Nothing Then
Sheets("Sayfa2").Cells(k.Row, "B").Value = s1.Cells(i, "I").Value + Sheets("Sayfa2").Cells(k.Row, "B").Value
Sheets("Sayfa2").Cells(k.Row, "C").Value = s1.Cells(i, "J").Value + Sheets("Sayfa2").Cells(k.Row, "C").Value
Sheets("Sayfa2").Cells(k.Row, "D").Value = s1.Cells(i, "K").Value + Sheets("Sayfa2").Cells(k.Row, "D").Value
End If
End If
End If
Next i
Set s1 = Nothing
Set k = Nothing
End Sub