Option Explicit
Private ConsignesCouleurs As New Collection
Function AvecCouleur(ByVal Cel As Range)
Set Cel = Cel(1, 1)
ConsignesCouleurs.Add Array(Application.Caller, Cel.Interior.Color)
AvecCouleur = Cel.Value
End Function
Sub MettreLesCouleurs()
Dim CC()
While ConsignesCouleurs.Count >= 1
CC = ConsignesCouleurs(1)
ConsignesCouleurs.Remove 1
CC(0).Interior.Color = CC(1)
Wend
End Sub