Sub Comptabilise()
Dim NoDupes As New Collection
Dim tabl()
Application.ScreenUpdating = False
Range("D1").Value = "PERSONNE"
Range("E1").Value = "Montant total"
Range([A2], [A65536].End(xlUp)).Select
A = Selection.Value
ReDim tabl(1 To UBound(A), 1)
For i = 1 To UBound(A)
tabl(i, 1) = A(i, 1)
Next i
On Error Resume Next
For j = 1 To UBound(A, 1)
NoDupes.Add tabl(j, 1), CStr(tabl(j, 1))
Next j
On Error GoTo 0
For x = 1 To NoDupes.Count
For l = 1 To UBound(A)
If tabl(l, 1) = NoDupes(x) Then
Valeur = Valeur + Cells(l + 1, 2).Value
Else
End If
Next l
Cells(x + 1, 4) = NoDupes(x)
Cells(x + 1, 5) = Valeur
Valeur = 0
Next x
Application.Goto Reference:=Range("A1"), scroll:=True
End Sub