benzersizlerin konsolide toplamı

[Yesilyurtlu]

Uzmanlarım;
Ekli dosyamda
Sayfa1
Sayfa1.1
Sayfa1.2
diye sayfalarım mevcut.Bu sayfalarda a başlıklı sütununda kodlar mevcut. b başlıklı sütunumda da tutarlar mevcut.
Konsolide sayfamda ise
Sayfa1
Sayfa1.1
Sayfa1.2
sayfalarında a sütununda yer alan kodların benzersiz olanları aktarıpo kodlara ait tutarların toplamını b başlıklı sütuna alacağım.
Bu konuda yardımcı olabilir misiniz?

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Ozet()
 
    Dim s, a1, a2, deg
    Dim i As Long, j As Long, d As Object
 
    Sheets("konsolide").Select
    Range("B8:C" & Rows.Count).ClearContents
 
    Set d = CreateObject("Scripting.Dictionary")
 
    For i = 1 To Worksheets.Count
        With Sheets(i)
            If .Name <> "konsolide" Then
                For j = 6 To .Cells(Rows.Count, "B").End(xlUp).Row
                    deg = .Cells(j, "B")
                    If Not d.exists(deg) Then
                        s = .Cells(j, "C")
                        d.Add deg, s
                    Else
                        s = d.Item(deg)
                        s = s + .Cells(j, "C")
                        d.Item(deg) = s
                    End If
                Next j
            End If
        End With
    Next i
 
    a1 = d.keys: a2 = d.items
 
    For i = 0 To d.Count - 1
        Cells(i + 8, "B") = a1(i)
        Cells(i + 8, "C") = a2(i)
    Next i
 
End Sub

.

 

[Yesilyurtlu]

Ömer Uzmanım;
Teşekkür Ederim. Ellerine sağlık