Supprimer lignes qui contiennent la valeur de la cellule sélectionnée

Bonjour,

Actuellement, j'ai un code qui me permet de supprimer la ligne sélectionnée dans mon tableau, feuille "STOCK"

Et je voudrais que ça supprime également les entrées et les sorties qui ont le même code que celui que je supprime.

3copie-de-stock.zip (428.82 Ko)

Par exemple, dans ma feuille "STOCK", je sélectionne ma ligne qui a le code 0A-11, je la supprime avec la poubelle.

Je souhaiterais qu'il aille aussi rechercher dans les feuilles "ENTREE" et "SORTIE" s'il retrouve la valeur 0A-11 dans les colonnes correspondantes (colonne F pour la feuille "ENTREE" et H pour la feuille "SORTIE") . Et s'il en existe, supprimer également les lignes du tableau(et non de la feuille) qui contiennent cette valeur.

Merci beaucoup !

Bonjour

Vous avez protégé vos feuilles ENTREE et SORTIE. Quel est le mot de passe que je vérifie le code que je vais vous proposer ?

Cordialement

Bonjour Dan !

Autant pour moi, c'est "stock"

la feuille se protège après chaque entrée ou sortie , oublié de le retirer.

Merci

Celui-ci ne devrait pas avoir d'erreur si jamais

2copie-de-stock.zip (429.96 Ko)

Re

Ok merci mais je venais de le trouver par la variable PSW...
Attention que vous avez deux fois la macro Supprimer dans le fichier. Une fois dans la feuille Stock et une dans le module1
De mon coté, j'évite toujours de mettre des sub dans les feuilles voire de minimiser les codes dans les feuilles. Dans votre cas faites ceci :
- supprimer la macro Supprimer ligne qui se trouve dans la feuille stock
- dans votre module, remplacer la macro Supprimer lignes par celle ci-dessous :

'//BOUTON SUPPRIMER LIGNE DU TABLEAU SELECTIONNE
Sub supprimer_ligne()
Dim Code As String
Dim lo As ListObject, lr As ListRow, lRowInTable As Long

If Not ActiveCell.ListObject Is Nothing Then
    msg = "Supprimer cette ligne " & ActiveCell.Row & " ?"
    Style = vbYesNo + vbCritical + vbDefaultButton2
    Title = "Suppression"
    Response = MsgBox(msg, Style, Title)
    If Response = vbYes Then

        Set lo = ActiveCell.ListObject

        lRowInTable = ActiveCell.Row - lo.HeaderRowRange.Row
        Code = lo.DataBodyRange.Item(lRowInTable, 7)
        Set lr = lo.ListRows(lRowInTable)
        lr.Range.Delete

        With Feuil5.ListObjects("Tabentree") 'feuille ENTREE
            On Error Resume Next
            Lig = .DataBodyRange.Find(Code, LookIn:=xlValues, Lookat:=xlWhole).Row - 16
            If Lig > 0 Then
                Feuil5.Unprotect PSW
                .ListRows(Lig).Range.Delete
                Lig = 0
                Feuil5.Protect PSW
            End If
        End With

        With Feuil3.ListObjects("Tabsortie") 'Feuille SORTIE
            Lig = .DataBodyRange.Find(Code, LookIn:=xlValues, Lookat:=xlWhole).Row - 16
            If Lig > 0 Then
                Feuil3.Unprotect PSW
                .ListRows(Lig).Range.Delete
                Lig = 0
                Feuil3.Protect PSW
            End If
        End With
    End If
    Else
    Exit Sub
End If
End Sub

J'ai apporté les changements suivants :
- rajouté une variable Code
- rajouté la n° de ligne sélectionnée dans la variable "msg" pour que ce soit précisé dans le message
- rajouté les lignes de code pour la suppression demandée (feuille Entree et Sortie) en dessous de la ligne "lr.Range.Delete

Cordialement

Oui, en fait je l'avais 2 fois, celle d'en le module1 était en public car je l'utilise sur les autres feuilles.

J'avais dupliqué le code dans la feuille stock pour le modifié par après., mais peu importe.

Cela fonctionne bien mais à première vue, il ne retire qu'une seule ligne, que ça soit dans ENTREE ou SORTIE, alors qu'il peut y en avoir plusieurs.

Merci !

Cela fonctionne bien mais à première vue, il ne retire qu'une seule ligne, que ça soit dans ENTREE ou SORTIE, alors qu'il peut y en avoir plusieurs.

Ah ok là c'est plus complexe.

Donc une seule ligne dans stock mais plusieurs lignes dans Entrée et Sortie ?

Oui, en fait je l'avais 2 fois, celle d'en le module1 était en public car je l'utilise sur les autres feuilles

Ok. Le mieux est de n'en faire qu'une seule mais cela reste à voir

Ah ok là c'est plus complexe.

Ca l'est déjà bien assez pour moi

Petite question, combien pensez-vous avoir de lignes de données dans les feuilles Entree et Sortie

Si à chaque fin d'année j'exporte les entrées et sorties sur un autre fichier et que je remet à 0 les tableaux, je dirais pour prendre un peu large 2000 entrées et..peut-être 20000 sorties. Franchement très difficile à prévoir, et puis rien pour le moment me dis que je remettrai les tableaux à 0 chaque année. Si je peux cumuler les entrées et sorties sur 5 ans admettons, avant d'exporter ça serait top.

Bonjour

Merci des infos. Là il y a pas mal de données à traiter éventuellement. Faites ceci :

1. Dans le code Private Sub Worksheet_SelectionChange(ByVal Target As Range) qui se trouve dans les feuilles ENTREE et STOCK, ajoutez cette ligne

If Target.Count > 1 Then Exit Sub

2. Dans le module 1, remplacez la macro Supprimer que je vous avais donnée par celle ci-dessous

'//BOUTON SUPPRIMER LIGNE DU TABLEAU SELECTIONNE
Sub supprimer_ligne()
Dim Code As String
Dim lo As ListObject, lr As ListRow, lRowInTable As Long

If Not ActiveCell.ListObject Is Nothing Then
    msg = "Supprimer cette ligne " & ActiveCell.Row & "?"
    Style = vbYesNo + vbCritical + vbDefaultButton2
    Title = "Suppression"
    Response = MsgBox(msg, Style, Title)
    If Response = vbYes Then

        Set lo = ActiveCell.ListObject

        lRowInTable = ActiveCell.Row - lo.HeaderRowRange.Row
        Code = lo.DataBodyRange.Item(lRowInTable, 7)
        Set lr = lo.ListRows(lRowInTable)
        lr.Range.Delete

        Dim c As Range, Rng As Range
        Dim firstaddress As String
        Dim lig As Long
        Dim Feuille
        Dim i As Byte, j As Byte

        Feuille = Array(Feuil3, Feuil5)

        For i = 0 To UBound(Feuille)
            With Feuille(i).ListObjects("TAB" & Feuille(i).Name)

                Feuille(i).Unprotect PSW
                Set c = .DataBodyRange.Find(Code, LookIn:=xlValues)
                If Not c Is Nothing Then
                    firstaddress = c.Address
                    Do
                        lig = Range(c.Address).Row - 16
                        .ListRows(lig).Range.ClearContents
                        j = j + 1
                        Set c = .DataBodyRange.FindNext(c)
                        On Error Resume Next

                    Loop While Not c Is Nothing And c.Address <> firstaddress '--> Dan

                    Set Rng = .DataBodyRange.SpecialCells(xlCellTypeBlanks)
                    If j = 1 Then
                        .ListRows(lig).Range.Delete: j = 0
                    Else: Rng.Delete
                    End If
                End If
                Feuille(i).Protect PSW
            End With
        Next i
    End If
End If

Cordialement

Bonsoir Dan,

Toutes les données du code se suppriment bien dans les 2 tableaux, par contre dans le tableau des sorties, ça agit plus comme "effacer le contenu" car le tableau ne se réduit pas.

Egalement, ça me fait une erreur avec ce code ci qui se trouve dans la feuille sortie.

'//AFFICHE LA REMARQUE SI "X" SELECTIONNE DANS LES SORTIES
i = Target.Offset(, 1)
If Target.Column = 13 Then
    Target.Offset(, 1).Select             <======== l'erreur
        If Selection <> "" Then
           MsgBox i, , "Remarque"
        Else
        Exit Sub
        End If
End If

En retirant ce code, le tableau ne supprime pas les lignes non plus.

Et pourquoi ne dois-je pas ajouter cette ligne dans la feuille SORTIE également ?

If Target.Count > 1 Then Exit Sub

Merci à toi !!

Bonjour

Et pourquoi ne dois-je pas ajouter cette ligne dans la feuille SORTIE également ?

Ben en fait, je me suis trompé. C'est dans les feuilles ENTREE et SORTIE que vous devez ajouter la ligne.
Après l'erreur ne devrait plus se produire.

Bonjour,

Plus d'erreur avec le petit code mais le tableau sortie ne s'est pas réduit non plus. La colonne N qui est masquée peut poser ce problème ?

La colonne N qui est masquée peut poser ce problème ?

Non car la colonne N fait partie du tableau structuré et le code utilise ce nom pour la suppression de la ligne.

Mais bizarre je n'ai pas ce souci avec votre fichier. Essayez avec celui-ci

2copie-de-stock.zip (410.29 Ko)

Toujours pareil

J'ai eu aussi ce souci sur cette feuille. Mais le problème a été résolu en ajoutant la variable j

Je ne comprends pas que vous ayez le problème avec le fichier que je viens de vous poster sachant que cela fonctionne chez moi

Dans mon fichier posté, dites-moi quelle ligne vous supprimez et si vous partez bien de la feuille Stock pour la sélection

Edit : pour le code que je vous ai proposé vous devez toujours partir de la feuille STOCK

Oui je supprime toujours depuis la feuille stock puisque j'ai mis la macro sur la "poubelle"

j'avais commencé par supprimer la ligne 18, "TEST2". J'ai essayé les autres également par après aussi.

EDIT : Autant pour moi, en commençant par supprimer "TEST2" , ça fonctionne mais si je supprime "TEST3", qui sont les 2 dernières lignes dans le tableau de sortie, alors la les lignes restent.

J'ai trouvé le souci. En fait le code voyait des cellules vides dans des lignes non concernées par la suppression de la ligne.

Essayez comme ceci

'//BOUTON SUPPRIMER LIGNE DU TABLEAU SELECTIONNE
Sub supprimer_ligne()
Dim Code As String
Dim lo As ListObject, lr As ListRow, lRowInTable As Long

If Not ActiveCell.ListObject Is Nothing Then
    msg = "Supprimer cette ligne " & ActiveCell.Row & "?"
    Style = vbYesNo + vbCritical + vbDefaultButton2
    Title = "Suppression"
    Response = MsgBox(msg, Style, Title)
    If Response = vbYes Then

        Set lo = ActiveCell.ListObject
        lRowInTable = ActiveCell.Row - lo.HeaderRowRange.Row
        Code = lo.DataBodyRange.Item(lRowInTable, 7)
        Set lr = lo.ListRows(lRowInTable)
        lr.Range.Delete

        Dim c As Range
        Dim firstaddress As String
        Dim lig As Long
        Dim Feuille
        Dim i As Byte

        Feuille = Array(Feuil3, Feuil5)

        For i = 0 To UBound(Feuille)
            With Feuille(i).ListObjects("TAB" & Feuille(i).Name)

                Feuille(i).Unprotect PSW
                Do
                    Set c = .DataBodyRange.Find(Code, LookIn:=xlValues)
                    If Not c Is Nothing Then
                        lig = Range(c.Address).Row - 16
                        .ListRows(lig).Range.Delete
                    End If
                 Loop While Not c Is Nothing

                Feuille(i).Protect PSW
            End With
        Next i
    End If
End If
End Sub

Désolé pour ne pas avoir vu cela

Crdlt

Aucun problème, je tentais de trouver la petite erreur de mon côté mais bon..un peu comme si j'essayais de traduire du mandarin

Ca fonctionne à merveille, un très grand merci pour tout ton taff !

Bonjour Dan,

Il ne me semblait pas avoir l'erreur avant ou alors j'avais oublié d'essayer mais j'ai une erreur qui se produit quand je supprime un article qui n'a ni sortie ni entrée.

Sur la ligne :

 Set c = .DataBodyRange.Find(code, LookIn:=xlValues)

Variable objet ou variable du bloc With non définie.

'//SUPPRIMER LIGNE PRODUIT + ENTREES + SORTIES
Sub supprimer_ligne_produit_stock()
Dim code As String
Dim lo As ListObject, lr As ListRow, lRowInTable As Long

Application.ScreenUpdating = False
If Not ActiveCell.ListObject Is Nothing Then
    msg = "Supprimer le code suivant : " & Range("H" & ActiveCell.Row) & " ?"
    Style = vbYesNo + vbCritical + vbDefaultButton2
    Title = "Suppression"
    Response = MsgBox(msg, Style, Title)
    If Response = vbYes Then

        Set lo = ActiveCell.ListObject
        lRowInTable = ActiveCell.Row - lo.HeaderRowRange.Row
        code = lo.DataBodyRange.Item(lRowInTable, 7)
        Set lr = lo.ListRows(lRowInTable)
        lr.Range.Delete

        Dim c As Range
        Dim firstaddress As String
        Dim lig As Long
        Dim Feuille
        Dim i As Byte

        Feuille = Array(Feuil3, Feuil5)

        For i = 0 To UBound(Feuille)
            With Feuille(i).ListObjects("TAB" & Feuille(i).Name)
                Feuille(i).Unprotect PSW
                Do
 ==============>   Set c = .DataBodyRange.Find(code, LookIn:=xlValues)
                    If Not c Is Nothing Then
                        lig = Range(c.Address).Row - 16
                        .ListRows(lig).Range.Delete
                    End If
                 Loop While Not c Is Nothing

                Feuille(i).Protect PSW
            End With
        Next i
    End If
End If
Application.ScreenUpdating = True
Worksheets("STOCK").Activate
End Sub

Sais-tu pourquoi ?

Merci,

Rechercher des sujets similaires à "supprimer lignes qui contiennent valeur selectionnee"