Private Sub ColorerSousTexte()
Dim rep As Variant
rep = InputBox("Entrez le texte à chercher:")
If Not rep = False Then
Dim c As Range
Dim pos As Single
For Each c In Range("A2:A7")
c.Font.ColorIndex = xlColorIndexAutomatic
pos = InStr(1, c.Text, rep)
If pos > 0 Then
Do
If Mid(c.Text, pos, Len(rep)) = rep Then c.Characters(pos, Len(rep)).Font.ColorIndex = 3
pos = pos + Len(rep) - 1
Loop While pos < Len(c.Text)
End If
Next
End If
End Sub