Sub Compte_rougeBis()
Dim r As Range, c As Range, X&, Var&
Set r = Sheets("Feuil1").Columns(1).CurrentRegion.Resize(, 1)
For Each c In r 'Plage à adapter
For X = 1 To Len(c)
If c.Characters(X, 1).Font.ColorIndex = 3 Then Var = Var + 1
Next X
If Var <> 0 Then c.Offset(0, 1).Value = Var
Var = 0
Next c
End Sub