Sub supprime()
Set c = ActiveSheet.Range("C1:DP24000").Find("aaa000000:HRG_GROUPE 1:LECTEUR", LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
For n = 3 To 120
If n <> c.Column And InStr(Cells(c.Row, n).Value, ":HRG_") <> 0 And InStr(Cells(c.Row, n).Value, ":LECTEUR") <> 0 Then
Cells(c.Row, n).Interior.ColorIndex = 3
End If
Next n
Set c = ActiveSheet.Range("C1:DP24000").FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
For n = 120 To 3 Step -1
For m = 24000 To 1 Step -1
If Cells(m, n).Interior.ColorIndex = 3 Then Cells(m, n).Delete shift:=xlShiftToLeft
Next m
Next n
End Sub