Sub SupprimerLignes()
Application.ScreenUpdating = False
Dim zone As Range
Dim F As Worksheet
Set F = ActiveSheet
tablo = F.Range("A2:A25000")
Dim L As Long
For n = LBound(tablo, 1) To UBound(tablo, 1)
If tablo(n, 1) = "" Or tablo(n, 1) = "Sect" Then
If Not zone Is Nothing Then
Set zone = Application.Union(zone, F.Rows(n + 1))
Else
Set zone = F.Rows(n + 1)
End If
End If
Next
zone.Delete
Application.ScreenUpdating = True
End Sub