Option Explicit
Private Sub Worksheet_Activate()
'
Dim c As Range
Dim CFound As Range
Dim Adresse$
Dim Code As Range
'
Application.ScreenUpdating = False
With Range("G16:I115")
.Interior.ColorIndex = xlNone
For Each c In Application.Range("Code")
Set CFound = .Find(what:=c.Text, LookIn:=xlValues, lookat:=xlWhole)
If Not CFound Is Nothing Then
Adresse = CFound.Address
Do
CFound.Interior.ColorIndex = c.Offset(0, 1).Interior.ColorIndex
Set CFound = .FindNext(CFound)
Loop While CFound.Address <> Adresse
End If
Next c
End With
Application.ScreenUpdating = True
End Sub