Kod Blokunu döngü içine alma

[seddur]

Merhaba.Aşağıda çoketopla makrolarından oluşan kod bloğunu daha kısa bir şekilde örneğin döngü içinde yazmak mümkün müdür?Bu kodlar üç ayrı butona toplam 85'er satır yazılacak bu durum işlemlerin çalışma hızınıda yavaşlatabilir.Yer kaplamasın diye 6 satır paylaştım.Sadece Baştaki ve sondaki hücre değerleri değişiyorYardımcı olabilirseniz sevinirim.
set s1=sheets("Döküm")
set s2=sheets("Liste")
s1.Range("c4") = Application.WorksheetFunction.SumIfs(s2.Range("E2:E50000"), s2.Range("D2:d50000"), "=" & s1.Range("F2"), Sheets("Liste").Range("b2:b50000"), [B4])
s1.Range("c5") = Application.WorksheetFunction.SumIfs(s2.Range("E2:E50000"), s2.Range("D2:d50000"), "=" & s1.Range("F2"), Sheets("Liste").Range("b2:b50000"), [B5])
s1.Range("c6") = Application.WorksheetFunction.SumIfs(s2.Range("E2:E50000"), s2.Range("D2:d50000"), "=" & s1.Range("F2"), Sheets("Liste").Range("b2:b50000"), [B6])
s1.Range("c7") = Application.WorksheetFunction.SumIfs(s2.Range("E2:E50000"), s2.Range("D2:d50000"), "=" & s1.Range("F2"), Sheets("Liste").Range("b2:b50000"), [B7])
s1.Range("c8") = Application.WorksheetFunction.SumIfs(s2.Range("E2:E50000"), s2.Range("D2:d50000"), "=" & s1.Range("F2"), Sheets("Liste").Range("b2:b50000"), [B8])
s1.Range("c9") = Application.WorksheetFunction.SumIfs(s2.Range("E2:E50000"), s2.Range("D2:d50000"), "=" & s1.Range("F2"), Sheets("Liste").Range("b2:b50000"), [B9])

 

[AdemCan]

Merhaba, örnek dosya paylaşır mısınız?

 

[seddur]

Dosya ektedir.Döküm sayfasındaki tabloda ürünlerin toplamları Günlük tarihe göre, aya göre ve yıla göre alınmaktadır.Kodların bir kısmını yazdım.(comboboxları aktif etmek için sayfa değiştirin)

 

[AdemCan]

Örnek olarak CommandButton2 kodları için döngü işlemi.
Diğer butonlar içinde bu örneğe göre yapabilirsiniz.

Private Sub CommandButton2_Click()

Dim dokum As Worksheet, liste As Worksheet, dson As Long, lson As Long, i As Long, sutun As Integer, s As Integer
Set dokum = Sheets("Döküm")
Set liste = Sheets("Liste")
dson = dokum.Cells(Rows.Count, "C").End(3).Row
sutun = dokum.Cells(3, Columns.Count).End(1).Column
lson = liste.Cells(Rows.Count, "A").End(3).Row

For s = 3 To sutun Step 2
    For i = 4 To dson
        dokum.Cells(i, s).Value = WorksheetFunction.SumIfs(liste.Range("E2:E" & lson), liste.Range("D2:D" & lson), "=" & dokum.Range("F2"), liste.Range("B2:B" & lson), dokum.Cells(i, s - 1).Value)
    Next i
Next s
End Sub