Sub Supprime()
Dim ws As Worksheet, tablo, i, n
Set ws = Worksheets("Feuil1")
tablo = ws.[A1].CurrentRegion.Resize(, 2) 'matrice plus rapide, au moins 2 éléments
For i = 1 To UBound(tablo)
If Not tablo(i, 1) Like "*NEW*" Then
n = n + 1
tablo(n, 1) = tablo(i, 1)
End If
Next
'---restitution---
With ws.[A1] '1ère cellule de destination
If n Then .Resize(n) = tablo
.Offset(n).Resize(ws.Rows.Count - n - .Row).ClearContents 'RAZ en dessous
End With
End Sub