Sub MettreEnRouge()
Dim deb&, fin&, c
With Sheets("Catalogue foret")
For Each c In .Range("b2:b" & .Cells(.Rows.Count, "b").End(xlUp).Row)
deb = InStr(c, "Ø")
If deb > 0 Then
fin = InStr(deb, c, " ")
c.Font.ColorIndex = xlColorIndexAutomatic
c.Characters(deb, fin - deb).Font.ColorIndex = 3
End If
Next c
End With
End Sub