Supprimer les lignes en fonction d'une colonne

Bonjours tout le monde,

je vous écrit parce que je suis en train de faire ma première macro, et biensur, j'y arrive pas ...

Je voudrait avoir une macro qui me permettrai de supprimer toutes les lignes contenant "annulee" et "autre" dans la colonne statut. Le dire comme ça c'est simple mais bon ...

Je vous joint le fichier correspondant.

voila la (petite) partie que j'ai pour le moment

Sub EDITER()
'
' EDITER Macro
' Macro enregistrée le 29/04/2011 
'
    Rows("??").Select
    Selection.Delete Shift:=xlUp
End Sub

Je sais pas comment lui dire de sélectionner la bonne ligne ...

C'est peut etre en rajoutant la ligne suivante ... ?

Cells.Find(What:="Annulee", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
True).Activate
43exemple-wawa07.zip (6.74 Ko)

Bonjour

Macro à placer dans un module :

Sub SupprimeLigne()
Dim Lg As Integer, i as integer
Application.ScreenUpdating = False

    'Dernière ligne remplie de la colonne A
    Lg = Range("A65536").End(xlUp).Row

    'De la ligne 2 à la dernière ligne remplie
    For i = 2 To Lg

    'Si la cellule Ki ="Annulee" ou "Autre" la ligne est supprimée
    If Cells(i, 11).Value = "Annulee" Or Cells(i, 11).Value = "Autre" Then Rows(i).Hidden = True

    'Ligne suivante
    Next

End Sub

Avec ton exemple, il ne reste que "Envoyee" - Donc si le but est de ne garder que les "Envoyee"

Sub SupprimeLigne()
Dim Lg As Integer, i as integer
Application.ScreenUpdating = False

    'Dernière ligne remplie de la colonne A
    Lg = Range("A65536").End(xlUp).Row

    'De la ligne 2 à la dernière ligne remplie
    For i = 2 To Lg

    'Si la cellule Ki différente de "Envoyee" la ligne est supprimée
    If Cells(i, 11).Value <> "Envoyee" Then Rows(i).Hidden = True

    'Ligne suivante
    Next

End Sub

Amicalement

Nad

Bonjour,

Peut-être comme cela dans un module Standard

Sub EnleveLigne()
Dim DerLig As Long, i As Integer
Application.ScreenUpdating = False
DerLig = Range("K65536").End(xlUp).Row
    For i = DerLig To 2 Step -1
        If Feuil1.Range("K" & i).Value <> "Envoyee" Then Rows(i).EntireRow.Delete
    Next i
Application.ScreenUpdating = True
End Sub

Fais:

Outils/macro/macro/EnleveLigne

Tu peux éventuellement coller ces lignes de codes sur un bouton ou un Évènementiel

EDIT: Salut Nad et excuses ma lenteur...je me soigne

Bonne Journée

36wawa07.zip (11.83 Ko)

Bonjour à tous,

Avec un filtre élaboré (+ rapide si beaucoup de lignes)

Sub SupprLignes()
'--- Supprime lignes avec "Annulee" ou "Autre" dans coonne "Statut" ---
Dim Lg%, Rep%
    On Error GoTo Fin
    Lg = Range("a65536").End(xlUp).Row
    Range("o2") = "=OR(k2=""Annulee"",k2=""Autre"")"
    Range("a1:k" & [a65000].End(xlUp).Row).AdvancedFilter Action:=xlFilterInPlace, _
    CriteriaRange:=Range("o1:o2"), Unique:=False

    Application.Goto Range("h1"), Scroll:=True
    Rep = MsgBox("Ces lignes vont être supprimées" & Chr(10) & "Confirmez ?", vbYesNo + vbCritical + vbDefaultButton2, "Tableaux ")

    If Rep = vbNo Then GoTo Fin
    Range(Cells(2, "a"), Cells(Lg, "a")).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Fin:
    On Error Resume Next
        ActiveSheet.ShowAllData
    On Error GoTo 0
    Range("o2").ClearContents
    Application.Goto Range("a1"), Scroll:=True
End Sub

Amicalement

Claude

Merci beaucoup pour vos réponses,

et c’est vrais que le fichier est, en réalité, assez long (+ ou - 3800)...

A bientot

Bonjours,

(Désolé de faire un poste double)

En fin de compte, j'ai mofifier la structure des tableaux (j'ai rajouté des colonnes); ce qui fait que la macro de Claude avec le filtre élaboré, ne fonctionne plus

Sub SupprLignes()

Dim Lg%, Rep%
    On Error GoTo Fin
    Lg = Range("a65536").End(xlUp).Row
    Range("o2") = "=OR(k2=""Annulee"",k2=""Autre"")"
    Range("a1:k" & [a65000].End(xlUp).Row).AdvancedFilter Action:=xlFilterInPlace, _
    CriteriaRange:=Range("o1:o2"), Unique:=False

    Application.Goto Range("h1"), Scroll:=True
    Rep = MsgBox("Ces lignes vont être supprimées" & Chr(10) & "Confirmez ?", vbYesNo + vbCritical + vbDefaultButton2, "Tableaux ")

    If Rep = vbNo Then GoTo Fin
    Range(Cells(2, "a"), Cells(Lg, "a")).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Fin:
    On Error Resume Next
        ActiveSheet.ShowAllData
    On Error GoTo 0
    Range("o2").ClearContents
    Application.Goto Range("a1"), Scroll:=True

End Sub

Je viens demander votre aide pour qu'on m'explique ce qu'il faudrait modifier pour pouvoir l'adapter à mon nouveau classeur (cf ci-dessous)

Un grand merci pour l'aide que vous m'avez apporté jusque là. A bientot

Bonsoir,

ces 2 lignes sont à adapter à ton fichier

"k2" est la colonne à tester

"o2" est la cellule de critères, tu peux la mettre après le tableau (en "s2" par exemple)

    Range("o2") = "=OR(k2=""Annulee"",k2=""Autre"")"
    Range("a1:k" & [a65000].End(xlUp).Row).AdvancedFilter Action:=xlFilterInPlace, _
    CriteriaRange:=Range("o1:o2"), Unique:=False

si problème, envoie seulement les en-têtes et quelques lignes (structure réelle)

Amicalement

Claude

ah mince, mon fichier devait être trop gros, car j'était sur de l'avoir envoyé :-/

Merci beaucoup Claude pour ta réponse rapide.

En fait je comprenait pas a quoi servait le "O", donc j'y avait pas touché...

Ca marche super bien maintenant!!

Encore merci. A bientot

Rechercher des sujets similaires à "supprimer lignes fonction colonne"