Sub somme()
' code transmis par laetitia90
Dim t(), i As Long, m As Object, c As Byte, z
Set m = CreateObject("Scripting.Dictionary")
t = Range("a2:d" & Cells(Rows.Count, 1).End(3).Row).Value2
For i = 1 To UBound(t)
z = t(i, 1)
If m.Exists(z) Then
For c = 2 To 3: t(m(z), c) = t(m(z), c) + t(i, c): Next c
t(m(z), 4) = t(m(z), 4) + 1
Else
x = x + 1
For c = 1 To 3: t(x, c) = t(i, c): Next c: m(z) = x
t(x, 4) = 1
End If
Next i
[F2].Resize(x, 4) = t
End Sub