Option Explicit
Declare Sub Sleep Lib 'kernel32' (ByVal dwMilliseconds As Long)
Sub LookingForRedCell()
Dim FirstCell As Range
Dim Cell As Range
Dim Plage As Range
Dim i As Byte
For Each Cell In Range('B5:H90')
If Cell = Range('B1') Then
Set FirstCell = Cell
Exit For
End If
Next
If FirstCell Is Nothing Then
MsgBox 'Date ' & Range('B1') & ' non trouvée, procédure avortée', vbCritical
Exit Sub
End If
Set Plage = Range(FirstCell.Offset(1, 0), ActiveCell.Offset(98, 0))
For Each Cell In Plage
If Cell.Interior.ColorIndex = 3 Then
Cell.Activate
For i = 1 To 10
Sleep (100)
Cell.Interior.ColorIndex = 6
Sleep (100)
Cell.Interior.ColorIndex = 3
Next i
Exit For
End If
Next
End Sub