Sub Insert()
Dim P As Range, i&
Set P = Intersect(ActiveSheet.UsedRange.EntireRow, Range("A9:D" & Rows.Count))
If P Is Nothing Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next 'sécurité
For i = P.Rows.Count To 1 Step -1
If P(i, 1).Interior.ColorIndex = 15 Then P.Rows(i).Delete xlUp
Next
P.Sort P(1), xlAscending, Header:=xlNo 'tri
For i = P.Rows.Count To 2 Step -1
If IsDate(P(i, 1)) Then
If Application.WeekNum(P(i, 1)) <> Application.WeekNum(P(i - 1, 1)) Then
P.Rows(i).Insert xlDown
P.Rows(i).Interior.ColorIndex = 15 'gris
End If
End If
Next
End Sub