une proposition à tester :
Sub test()
Dim lastLigne As Integer
Dim resultat As Integer
Dim tmp As Integer
Dim max As Integer
Dim tmp2 As Integer
tmp = 2
lastLigne = Range("A" & Rows.Count).End(xlUp).Row
max = Cells(lastLigne, 1).Value
For i = 1 To max
tmp2 = tmp
While Cells(tmp, 1) = i
resultat = resultat + Cells(tmp, 2).Value
tmp = tmp + 1
Wend
Cells(tmp2, 3).Value = resultat
resultat = 0
Next i
End Sub
avec le mini tableau que vous avez fournie cela marche j'attend votre retour et disponible pour tout question concernant le code