Sub ComCoul()
Dim TabT(), Dico, i As Integer, j As Integer, x As Integer, k As Integer
Dim clé, y As Integer, Lig As Integer, Col As Integer, TabCoul
Set Dico = CreateObject("Scripting.Dictionary")
With Worksheets("Données")
.Range("A1").CurrentRegion.Select
Lig = .Range("A1").CurrentRegion.Rows.Count
Col = .Range("A1").CurrentRegion.Columns.Count
For i = 1 To Lig
For j = 1 To Col
If .Cells(i, j).Interior.ColorIndex <> xlNone Then
x = x + 1
ReDim Preserve TabT(1 To x)
TabT(x) = .Cells(i, j).Interior.ColorIndex
End If
Next
tri TabT
For k = LBound(TabT) To UBound(TabT)
clé = clé & TabT(k) & "|"
Next
Dico(clé) = Dico(clé) + 1
Erase TabT
x = 0
clé = ""
Next
y = Lig + 2
For Each clé In Dico.Keys
TabCoul = Split(clé, "|")
y = y + 1
For i = 1 To k - 1
.Cells(y, i).Interior.ColorIndex = TabCoul(i - 1)
Next
.Cells(y, k) = Dico(clé) / Lig
Next
End With
End Sub