Option Explicit
Option Compare Text 'la casse est ignorée
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim t1, t2, i&, t, j&
With Feuil1 'CodeName de la feuille source
If Sh.Name = .Name Then Exit Sub
Application.ScreenUpdating = False
t1 = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)(2))
t2 = Sh.Range("A1", Sh.Range("A" & Sh.Rows.Count).End(xlUp)(2))
Sh.Range("A" & Rows.Count).Interior.ColorIndex = xlNone 'RAZ
For i = 2 To UBound(t2)
t = t2(i, 1)
For j = 2 To UBound(t1)
If t1(j, 1) = t Then
If .Cells(j, 1).Interior.ColorIndex <> xlNone Then
Sh.Cells(i, 1).Interior.Color = .Cells(j, 1).Interior.Color
Exit For
End If
End If
Next
Next
Application.ScreenUpdating = True
End With
End Sub