Mükerrer kayıt topla ve sil

[acolkesen1]

Merhaba Arkadaşlar,
Ekli dosyada açıkladığım üzere, Mükerrer kayıtların toplanarak silinmesi konusunda Sayın Evren Gizlen'in kodlarından yararlanarak bir çalışma yapmak istedim. Ancak mükerrer kayıtların tekrar sayısına göre veya anlayamadığım farklı sebeplerden dolayı zaman zaman hatalı sonuçlar çıkmaktadır. Yardımcı olacak arkadaşlara teşekkür ederim.
Kodlar aşağıdaki gibidir;
Sub mukerrer()
Dim i As Long, sat As Long, sat2 As Long
Range("J1:M65536").Clear
sat = Cells(65536, "A").End(xlUp).Row
Application.ScreenUpdating = False
For i = 1 To sat
If WorksheetFunction.CountIf(Range("A1:A" & i), Cells(i, "A").Value) = 1 Then
sat2 = sat2 + 1
Cells(sat2, "a").Value = Cells(i, "A").Value
If WorksheetFunction.CountIf(Range("A1:A65536"), Cells(i, "A").Value) > 1 Then
Cells(sat2, "b").Value = WorksheetFunction.SumIf(Range("A" & i & ":A" & sat), Cells(i, "A").Value, Range("B" & i & ":B" & sat))
End If
End If
Next i
For a = [A65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("A1:A" & a), Cells(a, "A")) > 1 Or Cells(a, "A") = 11 Then Rows(a).Delete
Next
End Sub