VBA Supprimer des lignes selon le contenu de la cellule

Bonjour,

J'ai un fichier Fichier.xls qui contient deux feuilles, Feuille1 et Feuille2.

A/ Sur la Feuilles1 j'ai 4 colonnes avec la colonne B ("B2:B5420" & LastRow) qui contient des chiffres. ' La ligne 1 ce sont des en-têtes

B/ Sur la Feuille2 j'ai 2 colonnes avec la colonne A ("A32:A61") qui contient des chiffres. ' La ligne 1 ce sont des en-têtes

Ce que je cherche c'est de supprimer sur la Feuille1 toutes les lignes correspondantes à la colonnes B ("B2:B5420" & LastRow) et qui sont différentes pour un chiffre donné sélectionné à partir de la colonne A ("A32:A61") de la Feuille2.

C à d : Si Feuille1.Cells(ligneF1, 2).Value <> Feuille2.Cells(ligneF2, 1).Value Alors supprimer toute la ligne de la Feuille1.

J'ai essayé avec ce code que je trouve logiquement correct mais rien.

Sub Suppression()

'Suppression sur la feuille "1" des lignes différentes du num sélectionné
            Workbooks("Fichier.xlsx").Sheets(1).Activate

            DerLg = Workbooks("Fichier.xlsx").Sheets(1).Range("A" & Rows.Count).End(xlUp).Row

            Dim Plage As Range, Num As Long, i As Long, j As Long

            Workbooks("Fichier.xlsx").Sheets(2).Activate

                For j = 32 To 61

                NAdht = Workbooks("Fichier.xlsx").Sheets(2).Cells(j, 1)

            Workbooks("Fichier.xlsx").Sheets(1).Activate

                Set Plage = Workbooks("Fichier.xlsx").Sheets(1).Range("B2:B" & DerLg)

                    For Each Cellule In Plage

                        For i = DerLg To 2 Step -1

                        If Cells(Cellule.Row, 2).Value <> Num Then Rows(i).EntireRow.Delete

                        Next i

                    Next

                Next j

End Sub

Merci par avance pour votre retour.

Salut,

Num est censé avoir quelle valeur ? Je ne vois pas le moment ou tu lui en donnes une .. :/

En général, si tu veux voir si ton code fonctionne bien, utilise le mode pas à pas, et regarde si tes variables sont bien initialisées avec les valeurs que tu souhaite .. ici, je pense que Num garde une valeur "vide" ce qui perturbe un peu ton code.

Bibu

Bonjour BibuNesco,

Merci pour ton retour.

Dsl j'ai oublé de modifier dans mon code la variable Num qui est en faite NAdht.

En faite toujours rien.

Sub Suppression()

'Suppression sur la feuille "1" des lignes différentes du num sélectionné
            Workbooks("Fichier.xlsx").Sheets(1).Activate

            DerLg = Workbooks("Fichier.xlsx").Sheets(1).Range("A" & Rows.Count).End(xlUp).Row

            Dim Plage As Range, Num As Long, i As Long, j As Long

            Workbooks("Fichier.xlsx").Sheets(2).Activate

                For j = 32 To 61

                Num = Workbooks("Fichier.xlsx").Sheets(2).Cells(j, 1)

            Workbooks("Fichier.xlsx").Sheets(1).Activate

                Set Plage = Workbooks("Fichier.xlsx").Sheets(1).Range("B2:B" & DerLg)

                    For Each Cellule In Plage

                        For i = DerLg To 2 Step -1

                        If Cells(Cellule.Row, 2).Value <> Num Then Rows(i).EntireRow.Delete

                        Next i

                    Next

                Next j

End Sub

@+

Sinon, tu peux t'inspirer de ce topic là, qui est sensiblement la même problématique :

https://forum.excel-pratique.com/excel/traitement-d-une-colonne-avec-une-liste-160385

Bibu

Bonjour BibuNesco,

Je te remercie pour ta réponse.

J'ai modifié ce code et j'ai essayé avec mais il ne me supprime pas sur la Feuille1 toutes lignes pour un Numéro sélectionné sur la Feuille2, comme ainsi :

Si sur la Feuille1 la Cells(ligneFeuille1, 2).Value <> sur la Feuille2 la Cells(ligneFeuille2, 1).Value Alors supprimer toute la ligne de la Feuille1.

Pour plus d'info, ci-joint le fichier "Infos.xls" pour avoir une idée sur ce que je cherche.

Donc par exemple pour le Numéro 617 sur la Feuille2 s'il est sélectionné dans une boucle, il faut que sur la Feuille1 je trouve seulement les 27 lignes correspondantes au Numéro 617 et les autres seront supprimées et ainsi de suite selon le choix du numéro voulu sur la Feuille2.

Ci-dessous ton codé modifié comme suggéré :

Sub Test()

ThisWorkbook.Sheets(2).Activate

For l = 6 To 6 'En prenant par exemple le Numéro 617

Range("A" & l).Select

            Dim Ws_Feuille1 As Worksheet
            Set Ws_Feuille1 = Workbooks("Infos.xlsx").Worksheets(1)

            Dim Ws_Feuille2 As Worksheet
            Set Ws_Feuille2 = Workbooks("Infos.xlsx").Worksheets(2)

            Derlig_Feuille1 = Ws_Feuille1.Range("A" & Rows.Count).End(xlUp).Row

            Derlig_Feuille2 = Ws_Feuille2.Range("A" & Rows.Count).End(xlUp).Row

            Dim tab_Feuille2() As Variant
            tab_Feuille2 = Ws_Feuille2.Range("A2", "A" & Derlig_Feuille2)

            For i = Derlig_Feuille1 To 2 Step -1

                CompteEgalite = 0

                For j = LBound(tab_Feuille2, 1) To UBound(tab_Feuille2, 1)

                    If Ws_Feuille1.Range("B" & i) = tab_Feuille2(j, 1) Then
                        CompteEgalite = CompteEgalite + 1
                    End If

                Next j

                If CompteEgalite <> 0 Then
                    Ws_Feuille1.Range("A" & i).EntireRow.Delete
                End If

            Next i

Next l

End Sub

@+

Bonjour BibuNesco,

C'est bon j'ai réussi à modifier le code comme mentionné ci-dessous et supprimer les lignes selon la règle ci-desous :

C à d : Si Feuille1.Cells(ligneF1, 2).Value <> Feuille2.Cells(ligneF2, 1).Value Alors supprimer toute la ligne de la Feuille1.

Sub Test()

ThisWorkbook.Sheets(2).Activate

For l = 6 To 6 'En prenant par exemple le Numéro 617

Range("A" & l).Select

            Dim Ws_Feuille1 As Worksheet
            Set Ws_Feuille1 = Workbooks("Infos.xlsx").Worksheets(1)

            Dim Ws_Feuille2 As Worksheet
            Set Ws_Feuille2 = Workbooks("Infos.xlsx").Worksheets(2)

            Derlig_Feuille1 = Ws_Feuille1.Range("A" & Rows.Count).End(xlUp).Row

            Derlig_Feuille2 = Ws_Feuille2.Range("A" & Rows.Count).End(xlUp).Row

            Dim tab_Feuille2() As Variant
            tab_Feuille2 = Ws_Feuille2.Range("A2", "A" & Derlig_Feuille2)

            For i = Derlig_Feuille1 To 2 Step -1

                CompteEgalite = 0

                    If Ws_Feuille1.Range("B" & i) = tab_Feuille2("A" & l) Then
                        CompteEgalite = CompteEgalite + 1
                    End If

                Next j

                If CompteEgalite = 0 Then
                    Ws_Feuille1.Range("B" & i).EntireRow.Delete
                End If

            Next i

Next l

End Sub

Merci pour ton aide précieuse et pour ton code qui m'a beaucoup aidé à atteindre mon objectif