Sub SupCoul()
Dim i As Long, DerL As Long
DerL = Range("A" & Rows.Count).End(xlUp).Row
For i = DerL To 1 Step -1
If Cells(i, 1).Interior.ColorIndex = 10 Then
x = i + 1
While Cells(x, 1).Interior.ColorIndex <> 3
x = x + 1
Wend
Range(Cells(i, 1), Cells(x, 1)).Delete Shift:=xlUp
End If
Next
End Sub