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