Benzersiz verileri saydırma

[aydgur]

Merhaba, daha önce siteden edindiğim aşağıdaki kod ile satış tl tutarını toplatabiliyordum.
C,D.E.F.G sütunlarını da toplatabilmek için nasıl ekleme yapmalıyım, yardım edermisiniz ?

Sub verileri_benzersiz_saydırma_temmuz()

Dim sh As Worksheet, ss As Long, z As Object, a, b(), i As Long, n As Long
Dim aranan As String

Set sh = Sheets("LİSTE")
ss = sh.Range("C" & Rows.Count).End(3).Row
Set z = CreateObject("Scripting.Dictionary")
z.comparemode = vbTextCompare
ReDim b(1 To 3, 1 To 1)
n = 0
a = sh.Range("A2:b" & ss).Value
For i = 1 To UBound(a, 1)
If a(i, 1) <> "" Then
aranan = a(i, 1)
If Not z.exists(aranan) Then
n = n + 1
z.Add aranan, n
ReDim Preserve b(1 To 3, 1 To n)
b(1, n) = a(i, 1)
b(2, n) = a(i, 2) * 1

Else
b(2, z.Item(aranan)) = b(2, z.Item(aranan)) * 1 + a(i, 2) * 1

End If
End If
Next i
sh.Range("H1").Value = "FİRMA"
sh.Range("I1").Value = "SATIŞ TL"
sh.Range("J1").Value = "TAHSİLAT TL"
sh.Range("K1").Value = "SATIŞ USD"
sh.Range("L1").Value = "TAHSİLAT USD"
sh.Range("M1").Value = "SATIŞ EURO"
sh.Range("N1").Value = "TAHSİLAT EURO"


sh.Range("H2:N" & Rows.Count).ClearContents
sh.Range("H2:N" & Rows.Count).Borders.LineStyle = xlNone
sh.Range("H2").Resize(z.Count, 2).Value = Application.Transpose(b)
With sh.Range("H2:N1" & z.Count)
.Borders.LineStyle = 1
.Font.Name = "Calibri"
.Font.Size = 10
End With
MsgBox "İşlem tamamlandı.", vbInformation, "antonio"
End Sub
Sub kar_liste()
'
' kg_liste Makro
'

'
Columns("J:M").Select
ActiveWorkbook.Worksheets("LİSTE").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("LİSTE").Sort.SortFields.Add Key:=Range("M2:M50247" _
), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("LİSTE").Sort
.SetRange Range("J1:M50247")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
MsgBox "Kâra göre sıralandı ."
End Sub