Private Sub Worksheet_Activate()
Dim dest As Range, c As Range, n%, source As Range, c1 As Range, x$, i As Variant
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'évite le recalcul des formules
On Error Resume Next 's'il n'y a pas de SpecialCells
Set dest = [B8:AB1829] 'plage à adapter
dest = "": dest.Interior.ColorIndex = xlNone 'RAZ
For Each c In Sheets("TAB").[B:B].SpecialCells(xlCellTypeConstants, 2) 'feuille et colonne à adapter
If c Like "TAB#*" Then
n = Val(Mid(c, 4))
Set source = c(5).Resize(10, 254) 'adapter éventuellement
For Each c1 In source.SpecialCells(xlCellTypeConstants, 1)
If c1.Interior.ColorIndex = 4 Then 'vert
x = Cells(c1.Row - source.Row + 1, c1.Column - source.Column + 1).Address(0, 0)
i = Application.Match(x, dest.Columns(0), 0)
If IsNumeric(i) Then dest(i, n).Interior.ColorIndex = 4: dest(i, n) = 1
End If
Next c1
End If
Next c
Application.Calculation = xlCalculationAutomatic
End Sub