XL 2016 donne valeur en fonction d'une couleur

Sub CouleurToInt()
Application.ScreenUpdating = False
Set tabloCoul = CreateObject("Scripting.dictionary")

With ActiveSheet
    Nbcoul = .Range("A" & .Rows.Count).End(xlUp).Row
'    For i = 1 To Nbcoul
'        If Not tabloCoul.exists(.Range("A" & i + 1).Interior.Color) Then
'            tabloCoul.Add .Range("A" & i + 1).Interior.Color, .Range("A" & i + 1)
'        End If
'    Next i
   
    For Each cel In .Range("ListeCouleurs")
        If Not tabloCoul.exists(cel.Interior.Color) Then
            tabloCoul.Add cel.Interior.Color, cel
        End If
    Next cel

    fin = .UsedRange.Rows.Count

    For i = 2 To fin
        .Range("G" & i) = tabloCoul.Item(Range("G" & i).Interior.Color)
    Next i
           
End With
Application.ScreenUpdating = True
End Sub