Sub SupprimeLignesInutiles()
Dim i As Integer
Set dicLignes = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
With Feuil1
For Each cel In Range("A1:M500")
' cette boucle balaie la plage définie et stocke dans le tabeau dicLignes _
les n° trouvés
If cel.Value Like "*TI43*" Then
If Not dicLignes.exists(cel.Row) Then dicLignes.Add cel.Row, cel.Row
End If
Next
l = dicLignes.items
For i = 0 To dicLignes.Count - 1
' cette boucle sélectionne toutes les lignes du tableau dicLignes
If i = 0 Then
' sélectionne la première ligne trouvée
.Rows(l(i)).EntireRow.Select
Else
' ajoute à la sélection les lignes suivantes
Application.Union(Selection, .Rows(l(i)).EntireRow).Select
End If
Next
' Efface les ligne sélectionnées en une seule opération
Selection.Delete
End With
Application.ScreenUpdating = True
Selection.Range("A1").Select
dicLignes = "" ' Efface le tableau
End Sub