aide: macro comparant valeurs d'1 colonne , additionant valeurs...

Bon, je suis un peu perdu   et j'espere qu'une ame charitable me viendra en aide. Tout d'abord je m'excuse par avance si je ne mets pas d'accents. Je suis en clavier querty et donc je ne les ai pas sous la main.

J'ai une macro a disposition, mais elle ne marche pas.
J'ai besoin de comparer les valeurs de la colonne "Res-ID" entre-elles. Si les valeurs sont identiques, je veux additioner les valeurs de la colonne "amount", de sorte que les doublons disparaissent et qu'il ne me reste qu'une seule ligne par code res-id, avec la somme des differentes lignes qui leur corresponde.



Account No. Nom Arrival Date Res-ID Amount
MARIE 31/01/2007 0144-2007512304 9.00
MARIE 31/01/2007 0144-2007512304 9.00
STEPHEN 31/01/2007 0139-2007801534 44.00
STEPHEN-2 31/01/2007 0139-2007801534 44.00
JAMES 31/01/2007 0139-2007231905 9.00
JAMES 31/01/2007 0135-2007541021 9.00
NICOLAS 31/01/2007 0135-2007541021 9.00
NICOLAS-2 31/01/2007 0133-2007960949 9.00
NICOLAS-3 31/01/2007 0133-2007960949 9.00


La macro est la suivante:

Sub Transfer_Addition()

Dim iListCount As Long
Dim iCtr As Long
Dim sheetvar

sheetvar = ActiveCell.Worksheet.Name
' Turn off screen updating to speed up macro.
Application.ScreenUpdating = False

' Get count of records to search through.
Set r = Range("Range1")
iListCount = CLng(r.Rows.Count)
ActiveSheet.Range("C1").Select
Dim newnum
' Loop until end of records.
newnum = 1
Dim rowvar
Dim celvar
Dim Newvar

Do Until iListCount = newnum


rowvar = ActiveCell.Row
celvar = ActiveCell.Value
' Loop through records.
For iCtr = 1 To CLng(iListCount)
' Don't compare against yourself.
' To specify a different column, change 1 to the column number.
If rowvar <> r.Cells(iCtr, 1).Row Then

' Do comparison of next record.
If celvar = r.Cells(iCtr, 1).Value Then
var2 = r.Cells(iCtr, 4)
var1 = ActiveCell(1, 4)
' If match is true then delete row.
r.Cells(iCtr, 1).Name = "Current"
Newvar = var1 + var2
ActiveCell(1, 4) = Newvar

Range("Current").EntireRow.Delete (xlShiftUp)
If Not ActiveCell.Address = "$C$1" Then
ActiveCell.Offset(-1, 0).Select

iCtr = iCtr + 1

' Increment counter to account for deleted row.
Else
iCtr = iCtr + 1

End If

End If
End If


Next iCtr
' Go to next record.
ActiveCell.Offset(1, 0).Select
newnum = newnum + 1
Loop




Application.ScreenUpdating = True
MsgBox "Done!"

End Sub


Je ne suis pas tres bon en macro   , alors si quelqu'un pouvait me faire profiter de ses lumieres, ce serait bien cool...
Merci