Sub Consolider()
Dim tablo, d As Object, i&, x$, n&
tablo = [B6].CurrentRegion.Resize(, 5) 'matrice, plus rapide, à adapter
Set d = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
x = "Fabricant " & tablo(i, 2) & " - Référence " & tablo(i, 3) & " - Coloris " & tablo(i, 4)
d(x) = d(x) + tablo(i, 5)
Next
n = d.Count
'---restitution---
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'si la feuille est filtrée
With [H7] '1ère cellule de restitution, à adapter
If n Then
.Resize(n) = Application.Transpose(d.keys) 'Transpose est limitée à 65536 lignes
.Cells(1, 2).Resize(n) = Application.Transpose(d.items)
End If
.Offset(n).Resize(Rows.Count - n - .Row + 1).ClearContents 'RAZ en dessous
End With
End Sub