Sub Copier_couleurs()
Dim source As Range, dest As Range, c1 As Range, coul&, x, c2 As Range
Set source = [I3:AB200]
Set dest = [AD3:BL200]
Application.ScreenUpdating = False
dest.Interior.ColorIndex = xlNone 'RAZ
For Each c1 In source
coul = c1.DisplayFormat.Interior.Color
If coul <> 16777215 Then 'si la cellule est colorée
x = c1.Value
For Each c2 In Intersect(c1.EntireRow, dest)
If c2 = x Then c2.Interior.Color = coul
Next c2
End If
Next c1
End Sub