Tekrarsız verileri başka sayfaya yazdırma

[Tefo]

Merhaba arkadaşlar,
Elimde binlerce satırdan oluşan ve tekrar eden isimler, yanlarında da tutarlar bulunmakta. Yapmak istediğim şey özet bir tablo oluşturmak. Tekrar etmeyen isimleri farklı bir sayfaya yazdırıp sumıfs ile toplamlarını aldırmak ve sıralamak. Konu biraz karmaşık olduğu için örnek dosya üzerinden de anlatmaya çalıştım. Destekleriniz için şimdiden teşekkür ederim.

Not:2016 ingilizce excel kullanıyorum.

 

[dEdE]

Örnek dosyanızda dener misiniz?

Sub FirmaTekrarsiz()
Dim myArr, myList As Variant
Set s1 = Sheets("DATA")
Set s2 = Sheets("ÖZET")
    ss = s1.Cells(Rows.Count, "A").End(3).Row
    myArr = s1.Range("A2:B" & ss)
    Set myList = CreateObject("System.Collections.ArrayList")
    For i = 1 To UBound(myArr)
       If Not myList.Contains(myArr(i, 1)) Then myList.Add myArr(i, 1)
    Next
    
s2.Range("A2:B" & s2.Cells(Rows.Count, "B").End(3).Row) = ""
Satır = 2
For k = 0 To myList.Count - 1
    T = 0
    For j = 2 To ss
        If myList(k) = s1.Cells(j, 1) Then
            T = T + s1.Cells(j, 2).Value
        End If
    Next j
    
    s2.Cells(Satır, 1) = myList(k)
    s2.Cells(Satır, 2) = T
    Satır = Satır + 1
Next k
Range("A2:B" & ss).Sort Key1:=[B1], Order1:=2

s2.Range("L3:M" & s2.Cells(Rows.Count, "M").End(3).Row) = ""

For i = 2 To s2.Cells(Rows.Count, "B").End(3).Row
    If s2.Cells(i, 2) < s2.Range("M1") Then
        Tpl = Tpl + s2.Cells(i, 2)
    Else
        s2.Cells(i + 1, 12) = s2.Cells(i, 1)
        s2.Cells(i + 1, 13) = s2.Cells(i, 2)
    End If
Next
    ss2 = s2.Cells(Rows.Count, "M").End(3).Row + 1
    s2.Cells(ss2, 12) = Range("M1").Value & " Altı satıcılar toplamı: "
    s2.Cells(ss2, 13) = Tpl
    s2.Cells(ss2, 13).NumberFormat = "#,##0.00"
End Sub

 

[Tefo]

Çok teşekkür ederim. Emeğinize sağlık. Tam ihtiyacım olan kod buydu..