Diğer sayfadan Şarta bağlı Küm. Rakamları almak

[erseljti]

Üstadlar
Ekte Makro çalışmamı bulabilirsiniz.İstediğimi genel anlamda özetleyecek olursam
Data sayfasındaki verdiğim şartın(Bu şart birden çok) istediğim alanlara toplamını yazması.Bir nevi exceldeki Topla.Çarpımın makrosu denilebilir.
İlgi ve yardımlarınzı rica ederim

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Sub AKTAR()
    Dim S1, S2, Son, Satir, Formul
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("Data")
    Set S2 = Sheets("Dst Kümüle")
    
    Son = S1.Cells(Rows.Count, 3).End(3).Row
    S2.Range("A3:P" & Rows.Count).ClearContents
    
    S1.Range("C3:C65536").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=S2.Range("A2"), Unique:=True
    
    Satir = S2.Cells(Rows.Count, 1).End(3).Row
    With S2.Range("B3:B" & Satir)
         Formul = "=SUMIF(" & S1.Name & "!C$4:C$1048576,A3," & S1.Name & "!V$4:V$1048576" & ")"
         Formul = Replace(Formul, 1048576, Son)
        .Formula = Formul
        .Value = .Value
    End With
    With S2.Range("C3:C" & Satir)
         Formul = "=SUMIF(" & S1.Name & "!C$4:C$1048576,A3," & S1.Name & "!U$4:U$1048576" & ")"
         Formul = Replace(Formul, 1048576, Son)
        .Formula = Formul
        .Value = .Value
    End With
    With S2.Range("D3:P" & Satir)
         Formul = "=SUMIF(" & S1.Name & "!$C$4:$C$1048576,$A3," & S1.Name & "!G$4:G$1048576" & ")"
         Formul = Replace(Formul, 1048576, Son)
        .Formula = Formul
        .Value = .Value
    End With
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[erseljti]

Sevgili Korhan Bey,
Çalışmamızı tamamlamızda değerli katkılarınızdan dolayı size minnettarım.
Bu çalışma ile Liste şeklinde verilen şarta bağlı toplamların toplamını alma anlamında güzel bir çalışma olmuştur.
Yani bir diğer değişle excel formülünde Topla.Çarpım Makrosu diyebiliriz.