Private Sub CommandButton1_Click()
Dim col As Byte
Application.ScreenUpdating = False
Me.AutoFilterMode = False 'filtre automatique désactivé
For col = 8 To Range("IV7").End(xlToLeft).Column Step 8
[COLOR="Red"]Synthese col[/COLOR]
Next
End Sub
Sub Synthese([COLOR="red"]col As Byte[/COLOR])
Dim derlig&, tablo, d As Object, i&, x&, t(), n&
derlig = Cells(8, col).End(xlDown).Row - 1
tablo = Range(Cells(8, col), Cells(derlig, col + 3))
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo)
If tablo(i, 4) <> "" Then
If d.exists(tablo(i, 4)) Then
x = Application.Match(tablo(i, 4), d.items, 0) - 1
t(x) = t(x) + tablo(i, 1)
Else
d.Add tablo(i, 4), tablo(i, 4)
ReDim Preserve t(n)
t(n) = tablo(i, 1)
n = n + 1
End If
End If
Next
'---Restitution sous le tableau---
Range(Cells(derlig + 4, col), Cells(65536, col + 1)).ClearContents
If n = 0 Then Exit Sub 'si aucune valeur
Cells(derlig + 4, col).Resize(n) = Application.Transpose(d.items)
Cells(derlig + 4, col + 1).Resize(n) = Application.Transpose(t)
End Sub