Sub Truc()
Dim t: t = Array("Page(s)", "Précéde", "Suivant")
Dim i As Integer
Dim adr1 As String
Dim c As Range
Dim PlageToDelete As Range
With Range("A1:A" & Range("A65536").End(xlUp).Row)
On Error Resume Next 'Au cas où il n'y ait pas de cellule vides
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
With .Resize(, 2)
For i = 0 To 2
adr1 = ""
Set c = .Find(What:=t(i), After:=.Cells(1), LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False, searchDirection:=xlNext)
If Not c Is Nothing Then
adr1 = c.Address: Debug.Print adr1
Do
If PlageToDelete Is Nothing Then
Set PlageToDelete = c
Else
Set PlageToDelete = Union(PlageToDelete, c)
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> adr1
Set c = Nothing
End If
Next i
If Not PlageToDelete Is Nothing Then PlageToDelete.EntireRow.Delete
End With
End With
End Sub