Sub CompteCouleurs()
Dim d As Object, r As Range, v&
Set d = CreateObject("Scripting.Dictionary")
With Feuil1 'CodeName
Set r = .Range("A2:A" & .UsedRange.Row + .UsedRange.Rows.Count - 1)
For Each r In r
v = r.Interior.Color 'couleur de fond
d(v) = d(v) + 1 'comptage
Next r
'---restitution---
Application.ScreenUpdating = False
Set r = .[F2] 'à adapter
r.Resize(.Rows.Count - r.Row + 1, 2).Clear 'RAZ
r.Resize(d.Count) = Application.Transpose(d.keys) 'Transpose est limitée à 65536 lignes
r(1, 2).Resize(d.Count) = Application.Transpose(d.items)
Set r = r.CurrentRegion
r.Borders.Weight = xlThin 'bordures
r.Columns(2).HorizontalAlignment = xlCenter 'cadrage
For Each r In r.Columns(1).Cells
r.Interior.Color = r
r = ""
Next r
End With
End Sub