aynı olan verilerin toplamı

[prodigy]

değerli dostlar
ekteki örnekde sayfa1 deki verileri sayfa2 ye kopyalayarak , bu verilerinin toplam değerlerini (aynı olanları bir defa alarak) makro kullanarak yazıyorum. ancak bu makroların yerine daha kısa veya daha değişik makro nasıl yapabiliriz.
saygılarımla

 

[hamitcan]

Aşağıdaki şekilde dener misiniz?

Sub bultopla()
c = 3
For i = 4 To Sayfa3.[b65536].End(3).Row
    topla = 0
For x = 4 To Sayfa1.[a65536].End(3).Row
    If x < 12 Then
        sat = 4
        ElseIf x < 18 And x > 12 Then
        sat = 12
        Else: sat = 18
    End If
        y = WorksheetFunction.Match("toplam", Sayfa1.Rows(sat), 0)
    
    If Sayfa1.Cells(x, 2) = Sayfa3.Cells(i, 3) Then
        topla = topla + Cells(x, y)
    End If
Next
        c = c + 1
        Sayfa3.Cells(c, "d") = Sayfa1.Cells(c, "c")
        Sayfa3.Cells(c, "e") = Sayfa1.Cells(c, "d")
        Sayfa3.Cells(c, "f") = Sayfa1.Cells(c, "e")
        Sayfa3.Cells(c, "g") = topla
Next
End Sub