Sub SuppressionLignes_Avec_Tri()
Dim t, P As Range
t = Timer
Set P = ActiveSheet.UsedRange
Application.ScreenUpdating = False
With P.Columns(P.Columns.Count + 1)
.Formula = "=REPT(123,$B2=""Sensibilisation R-TOL"")*1"
.Value = .Value
Union(P, .Cells).Sort .Cells, xlAscending 'tri pour accélérer
On Error Resume Next
.SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete
.Value = ""
End With
Set P = ActiveSheet.UsedRange 'MAJ des barres de défilement
MsgBox "Durée " & Format(Timer - t, "0.00 \s")
End Sub