Sub SupprimerLignes()
Dim t#
t = Timer
Application.ScreenUpdating = False
With Feuil1 'CodeName de la feuille
With .[AB4:AB12000] '1ère colonne vide, à adapter
.Formula = "=1/NOT(MOD(ROW()-2,29))"
.Value = .Value 'supprime les formules
.EntireRow.Sort .Cells, xlAscending, Header:=xlNo 'tri pour accélérer
.SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
.Value = "" 'RAZ
End With
With .UsedRange: End With 'actualise les barres de défilement
End With
Application.ScreenUpdating = True
MsgBox "Durée des suppressions " & Format(Timer - t, "0.00 \s") 'juste pour tester
End Sub