Sub Suppr()
Dim MonFiltre, c As Range, i&
MonFiltre = Sheets("Base").Range("I1").Value
Application.ScreenUpdating = False
With Sheets("test")
' afficher toutes les lignes - pour le bon fonctionnement de l'instruction END()
.Rows.Hidden = False
'supprimer les lignes qui ne contiennent pas MonFiltre
' remplacer <> par = pour supprimer les lignes contenant MonFiltre
For i = .Cells(.Rows.Count, "a").End(xlUp).Row To 1 Step -1
If .Cells(i, "d") <> MonFiltre Then .Rows(i).Delete
Next i
Application.Goto .Range("A1"), True
End With
End Sub