supprimer lignes selon une liste de valeurs

[alzi]

Bonjour,
Je suis une quiche en VBA et bien que plusieurs sujets traitent de ce problème, je ne suis pas arrivé à l'adapter à mon cas très simple.

J'ai une feuille de calcul sur laquelle je souhaite effacer toutes les lignes dont une des cellules est égale à une valeur dont j'ai la liste.
Comme je dois le faire sur plein de feuilles différentes, il me faut une petite macro.

Je joins le fichier exemple avec la liste des ocurences sur la deuxième feuilles du classeur.

Quelqu'un pourrait m'aider svp ?
Je vous remercie bien

 

[pierrejean]

Re : supprimer lignes selon une liste de valeurs

Bonjour alzi

Vois si cela te convient

 

[alzi]

Re : supprimer lignes selon une liste de valeurs

ça marche sur cette feuille mais je devrai appliquer la macro sur plein de feuilles différentes avec des noms différent.
Il ne faudrait donc pas utiliser dans la macro, le nom de la feuille sur laquelle on applique les suppressions.

Tu crois que c'est faisable ?
Merci

 

[pierrejean]

Re : supprimer lignes selon une liste de valeurs

Re

Une solution (il te suffit de mettre ans l'Array le nom de toutes les feuilles concernées) :

Sub supprimer()
lesfeuilles = Array("test", "Feuil1")
Application.ScreenUpdating = False
tablo = Sheets("Feuil2").Range("A2:A" & Sheets("Feuil2").Range("A655536").End(xlUp).Row)
For m = LBound(lesfeuilles) To UBound(lesfeuilles)
 For n = LBound(tablo, 1) To UBound(tablo, 1)
  Set c = Sheets(lesfeuilles(m)).Columns("F").Find(tablo(n, 1), LookIn:=xlValues, lookat:=xlWhole)
  If Not c Is Nothing Then
    Rows(c.Row).Delete
  End If
 Next n
Next m
Application.ScreenUpdating = True
End Sub

NB: il est aussi possible de ne faire reference qu'aux feuilles non concernées (cas ou ne conait pas les noms des feuilles concernées)

 

[alzi]

Re : supprimer lignes selon une liste de valeurs

Nickel ça marche
merci bien

 

[BOISGONTIER]

Re : supprimer lignes selon une liste de valeurs

Bonjour,

Méthode rapide

Sub supLignesRapide()
  Application.ScreenUpdating = False
  sup = Sheets("feuil2").[C2]
  a = Range("f2:f" & [f65000].End(xlUp).Row)
  For i = LBound(a) To UBound(a)
    If InStr(sup, a(i, 1)) = 0 Then a(i, 1) = 0 Else a(i, 1) = "sup"
  Next i
  Columns("b:b").Insert Shift:=xlToRight
  [B2].Resize(UBound(a)) = a
  [A2].CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess
  On Error Resume Next
  Range("B2:B65000").SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
  Columns("b:b").Delete Shift:=xlToLeft
End Sub

JB