Sub toto(Plg)
Dim i&, j&, Nom$, oCel As Range, oPlg As Range, refCol As Range, Table As Range
Set Table = Range("B5:BB13") 'premier tableau
For i = 0 To 4 'nb. de tableaux - 1
Set oPlg = Intersect(Plg, Table.Offset(12 * i))
If Not oPlg Is Nothing Then
Set refCol = Table.Offset(12 * i - 1, 54).Resize(1, 9)
Application.ScreenUpdating = False
For Each oCel In oPlg.Cells
oCel.Interior.ColorIndex = xlColorIndexNone: oCel.Font.ColorIndex = xlColorIndexNone
If Not IsEmpty(oCel) Then
Nom = CStr(Cells(oCel.Row, 2).Value)
For j = 1 To 9
If Nom = refCol.Cells(1, j).Value Then Exit For
Next j
If j < 10 Then oCel.Interior.Color = refCol.Cells(1, j).Interior.Color: oCel.Font.Color = refCol.Cells(1, j).Font.Color
End If
Next oCel
Application.ScreenUpdating = True
End If
Next i
End Sub