Sub Heures_tardives()
Dim P As Range, cel As Range, vide1 As Range, vide2 As Range, plag As Range
Set P = Cells.Find("POINTAGES", LookIn:=xlFormulas, LookAt:=xlWhole, MatchCase:=True)
If P Is Nothing Then MsgBox "Il faut la cellule POINTAGES": Exit Sub
Set cel = P.Offset(2)
While cel.Text <> ""
If cel.Text < "05:00" [COLOR="Red"]And CDate(cel.Offset(0, -3).Text) = CDate(cel.Offset(-1, -3).Text) + 1 [/COLOR]Then
Set vide1 = Range(cel.Offset(-1), cel.Offset(-1, 7)).Find("__:__")
Set vide2 = Range(cel, cel.Offset(0, 7)).Find("__:__")
Set plag = Range(cel.Offset(0, 1), vide2)
cel.Copy vide1
plag.Copy cel
End If
Set cel = cel.Offset(1)
Wend
End Sub