Mükerrer kayıt topla ve sil konusunda yardım..

[acolkesen1]

Merhaba Arkadaşlar,
Forumdaki örneklerden yararlanarak düzenlediğim aşağıdaki kod ile faturaya aktaracağım mükerrer kayıtların miktarlarını toplatarak fazla olanları silmek istiyorum. Toplam ve silme işleminde bir sorun yok ancak C sütunundaki ürün fiyatlarında kayma oluyor. Yardımcı olacak arkadaşlara teşekkür ederim.

Sub TOPLA_SİL()
Dim i As Long, sat As Long, sat2 As Long
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 b = [a65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("a1:C" & b), Cells(b, "a")) > 1 Then Rows(b).Delete
Next
Application.ScreenUpdating = True


End Sub

 

[acolkesen1]

Tekrar Merhaba,
Yukarıdaki koddan aşağıdaki satırı çıkararak sorunu çözdüm. İlgilenen arkadaşlara teşekkür ederim.
Cells(sat2, "a").Value = Cells(i, "A").Value