Sub Test()
Dim Numero, Col As Range, Premier, DerLigne1&, DerLigne2&, DerCol%, Resultat
DerLigne1 = Worksheets("STATUS").Range("C" & Rows.Count).End(xlUp).Row
DerLigne2 = Worksheets("BD").Range("B" & Rows.Count).End(xlUp).Row
DerCol = Worksheets("BD").Cells.Find("*", , , , xlByColumns, xlPrevious).Column
Numero = Worksheets("STATUS").Range("C15:C" & DerLigne1)
Worksheets("BD").Activate
With Worksheets("BD").Range(Cells(4, 2), Cells(4, DerCol))
Set c = .Find("B", LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
Premier = c.Address
Do
For j = 5 To DerLigne2
Resultat = Application.WorksheetFunction.CountIf _
(Worksheets("STATUS").Range("C15:C" & DerLigne1), _
Worksheets("BD").Cells(j, c.Column))
If Resultat = 0 Then
Worksheets("BD").Range(Cells(j, c.Column - 1), _
Cells(j, c.Column + 2)).Font.ColorIndex = 2
End If
Next j
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> Premier
End If
End With
End Sub