Sub Rassemble() 'outils,références cocher microsoft scripting runtime
Dim tbl(), a(), d As New Dictionary, i As Long, j As Long, c As Byte, item As Variant
tbl = Feuil2.Range("C10:M23") 'synthèse
For i = 1 To UBound(tbl)
Set d(tbl(i, 1)) = tbl(i, 1)
For c = 2 To UBound(tbl, 2)
If tbl(i, c) = "" Then tbl(i, c) = 0
Next
Next
ReDim Preserve a(1 To d.Count, 1 To 11)
For Each item In d.Items
j = j + 1: a(j, 1) = item
For c = 2 To UBound(a, 2)
a(j, c) = 0
Next
Next
For j = 1 To UBound(a)
For i = 1 To UBound(tbl)
If tbl(i, 1) = a(j, 1) Then
For c = 2 To UBound(tbl, 2)
a(j, c) = a(j, c) + tbl(i, c)
Next
End If
Next
Next
Feuil2.Range("C30").Resize(UBound(a, 1), UBound(a, 2)) = a
End Sub