Sub colorier(xplage As Range, xmot)
Dim xcell As Range, x, deb&, mot
Application.ScreenUpdating = False
xplage.Font.ColorIndex = xlColorIndexAutomatic
For Each xcell In xplage
mot = Trim(xmot) & " "
deb = 1
x = xcell.Value & " "
If Left(xcell, Len(mot)) = mot Then
xcell.Characters(1, Len(mot) - 1).Font.Color = RGB(255, 0, 0)
deb = Len(mot) + 1
End If
mot = " " & mot
Do
deb = InStr(deb, x, mot)
If deb > 0 Then
xcell.Characters(deb + 1, Len(mot) - 2).Font.Color = RGB(255, 0, 0)
deb = deb + Len(mot)
Else
Exit Do
End If
Loop
Next xcell
End Sub