Verifier 2 cellules et supprimer une ligne

Bonjour forum
puisque je suis nouveau sur vba, jais 2 petit problemes , jais 3 feuilles ,je veux un macro qui verifier 2 cellules si sont les memes supprimes la ligne de la 1er cellule
aussi un macro qui verifie tous les lignes d'un tableau si ila ya la condition copier les lignes sur un 2eme tableau ,(le problem toute fois une nouvelle ligne s'ajoute ila recopier toutes les lignes)

* historique analyse
Dim wk_fichier As Workbook
Dim ws_panne As Worksheet
Dim ws_analyse As Worksheet
Dim lstrw_histopanne, lstrw_histoanalyse As Long
Dim ligne_coller As Long
   'definir les variables fichiers et onglets
Set wk_fichier = ActiveWorkbook
Set ws_panne = wk_fichier.Worksheets(4)
Set ws_analyse = wk_fichier.Worksheets(5)
   'identifier dernière ligne colone A sheets("historique de panne")
lstrw_histopanne = ws_panne.Cells(Rows.Count, 1).End(xlUp).Row
   'commencer la boucle sur les lignes
For i = 7 To lstrw_histopanne
       'identifier le statut et si actif,copier coller en sheets("historique analyse")
    If ws_panne.Cells(i, 8) = "oui" Then
           'identifier derniere ligne colonne A sheets("historique analyse")
        ' lstrw_histoanalyse = ws_analyse.Cells(Rows.Count, 1).End(xlUp).Row
          lstrw_histoanalyse = ws_analyse.Cells(i + 1, 1).End(xlUp).Row
         ligne_coller = lstrw_histoanalyse + 1
           'copier coller de la cellule
        ws_analyse.Cells(ligne_coller, 1) = ws_panne.Cells(i, 5)

    End If
Next

End Sub

* effacer la ligne entière 
Worksheets("I.prod").Select
'effacer toute la ligne
For i = 8 To lstrw
If ActiveCell.Value <> " " Then
ActiveCell.EntireRow.Delete

End If
Next i
End Sub
7book1.xlsx (16.70 Ko)

Bonjour Youness, bonjour le forum,

En pièce jointe ton fichier modifié avec le code ci-dessous :

Option Explicit
Private O1 As Worksheet 'déclare la variable O1 (Onglet 1)
Private O2 As Worksheet 'déclare la variable O2 (Onglet 2)
Private O3 As Worksheet 'déclare la variable O3 (Onglet 1)
Private T1 As ListObject 'déclare la variable T1 (Tableau structuré 1)
Private T2 As ListObject 'déclare la variable T2 (Tableau structuré 2)
Private T3 As ListObject 'déclare la variable T3 (Tableau structuré 3)

Sub Macro1()
Dim I As Integer 'déclare la variable I (Incrément1)
Dim J As Integer 'déclare la variable J (incrément)

Set O1 = Worksheets("Sheet1") 'définit l'onglet O1
Set O2 = Worksheets("Sheet2") 'définit l'onglet O2
Set O3 = Worksheets("Sheet3") 'définit l'onglet O3
Set T1 = O1.ListObjects(1) 'définit le tableau structuré T1
Set T2 = O2.ListObjects(1) 'définit le tableau structuré T2
Set T3 = O3.ListObjects(1) 'définit le tableau structuré T3
For I = T2.ListRows.Count To 1 Step -1 'boucle 1 : inversée sur toutes les ligne I de T2 (de la dernière à la première)
    For J = 1 To T1.ListRows.Count 'boucle 2 : sur toutes les ligne J de T1
        'si la donnée ligne J colonne 1 de T1 est égale à la donnée ligne I de T2, supprime la ligne J de t1
        If T1.DataBodyRange(J, 1) = T2.DataBodyRange(I, 1) Then T1.ListRows(J).Delete
    Next J 'prochaine ligne de la boucle 2
Next I 'prochaine ligne de la boucle 1
End Sub

Sub Macro2()
Dim R As Range 'déclare la variable 1 (onglet 1)
Dim LI As Integer 'déclare la variable 1 (onglet 1)
Dim I As Integer 'déclare la variable 1 (onglet 1)

Set O1 = Worksheets("Sheet1") 'définit l'onglet O1
Set O2 = Worksheets("Sheet2") 'définit l'onglet O2
Set O3 = Worksheets("Sheet3") 'définit l'onglet O3
Set T1 = O1.ListObjects(1) 'définit le tableau structuré T1
Set T2 = O2.ListObjects(1) 'définit le tableau structuré T2
Set T3 = O3.ListObjects(1) 'définit le tableau structuré T3
For I = 1 To T2.ListRows.Count 'boucle sur toutes les ligne I de T2
    If T2.DataBodyRange(I, 3) = "oui" Then 'condition 1 : si la donnée ligne I colonne 3 de T2 est égale à "oui"
        Set R = T3.ListColumns(1).Range.Find("") 'définit la recherche R (recherche du vide dans la colonne 1 de t3)
        If R Is Nothing Or T3.ListRows.Count = 0 Then 'condition 2 : si occunne occurrence n'est trouvée ou si T3 ne contient pas de ligne
            T3.ListRows.Add 'ajoute une ligne à T3
            LI = T3.ListRows.Count 'définit la ligne LI
        Else 'sinon (au moins une occurrence trouvée)
            LI = R.Row - T3.HeaderRowRange.Row 'définit la ligne LI
        End If 'fin de la condition 2
        T2.ListRows(I).Range.Copy T3.DataBodyRange(LI, 1) 'copie la ligne I de t2 et la colle dans la donnée ligne LI colonne 1 de t3
    End If 'fin de la condition 1
Next I 'prochaine ligende la boucle
End Sub
4ynss-ed-v01.xlsm (24.93 Ko)

Merci pour votre repense le seul probleme pour le 2eme macro cest quand j'ajoute une autre ligne avec la condition "oui" et je click il recopier tous les lignes depuis le debut, je veux just copier la dernier ligne ajouter

Merci

Bonjour Youness, bonjour le forum,

Le code modifié. Le tableau dans Sheet3 est d'abord complètement effacé avant de recopier les lignes :

Sub Macro2()
Dim R As Range 'déclare la variable 1 (onglet 1)
Dim LI As Integer 'déclare la variable 1 (onglet 1)
Dim I As Integer 'déclare la variable 1 (onglet 1)

Set O1 = Worksheets("Sheet1") 'définit l'onglet O1
Set O2 = Worksheets("Sheet2") 'définit l'onglet O2
Set O3 = Worksheets("Sheet3") 'définit l'onglet O3
Set T1 = O1.ListObjects(1) 'définit le tableau structuré T1
Set T2 = O2.ListObjects(1) 'définit le tableau structuré T2
Set T3 = O3.ListObjects(1) 'définit le tableau structuré T3
T3.DataBodyRange.Delete 'supprime les données du tableau structuré T3 <----- ici
For I = 1 To T2.ListRows.Count 'boucle sur toutes les ligne I de T2
    If T2.DataBodyRange(I, 3) = "oui" Then 'condition 1 : si la donnée ligne I colonne 3 de T2 est égale à "oui"
        Set R = T3.ListColumns(1).Range.Find("") 'définit la recherche R (recherche du vide dans la colonne 1 de t3)
        If R Is Nothing Or T3.ListRows.Count = 0 Then 'condition 2 : si occunne occurrence n'est trouvée ou si T3 ne contient pas de ligne
            T3.ListRows.Add 'ajoute une ligne à T3
            LI = T3.ListRows.Count 'définit la ligne LI
        Else 'sinon (au moins une occurrence trouvée)
            LI = R.Row - T3.HeaderRowRange.Row 'définit la ligne LI
        End If 'fin de la condition 2
        T2.ListRows(I).Range.Copy T3.DataBodyRange(LI, 1) 'copie la ligne I de t2 et la colle dans la donnée ligne LI colonne 1 de t3
    End If 'fin de la condition 1
Next I 'prochaine ligende la boucle
End Sub

il donne une erreur

T3.DataBodyRange.Delete 'supprime les données du tableau structuré T3 <----- ici•••

Object variable or with block variable not set

bonjour,

a mon avis, il est important de sortir le dernier boucle dès qu'on a supprimer une ligne !!!

Aussi le dernier boucle ne doit pas faire tout le traject, seuelement jusqu'à I-1

Sub Macro1()
     Dim I     As Integer, J     As Integer, sh

     For Each sh In Array("sheet1", "sheet2", "sheet3") 'boucle des feuilles
          With Sheets(CStr(sh)).ListObjects(1)
               For I = .ListRows.Count To 2 Step -1     'boucle 1 : inversée sur toutes les ligne I de T2 (de la dernière à la première)
                    For J = 1 To I - 1   'boucle 2 : sur toutes les ligne J de T1
     'si la donnée ligne J colonne 1 de T1 est égale à la donnée ligne I de T2, supprime la ligne J de t1
                         If .DataBodyRange(J, 1) = .DataBodyRange(I, 1) Then .ListRows(I).Delete: Exit For 'IMPORTANT de sortir le boucle
                    Next J     'prochaine ligne de la boucle 2
               Next I     'prochaine ligne de la boucle 1
          End With
     Next
End Sub

je ne comprends pas le but exacte du 2ieme macro, mais pour vous donner un idée plus structuré

Sub macro2()
     Dim LO_Panne, LO_Analyse, LO_Synthese, LO, r As Variant, i

     Set LO_Panne = ThisWorkbook.Sheets("sheet1").ListObjects(1)     'les 3 listobjects
     Set LO_Analyse = ThisWorkbook.Sheets("sheet3").ListObjects(1)
     Set LO_Synthese = ThisWorkbook.Sheets("sheet2").ListObjects(1)

     With LO_Synthese
          If .ListRows.Count Then .DataBodyRange.Delete     'demarrer avec celui-ci vide
     End With

     For Each LO In Array(LO_Panne, LO_Analyse)     'les 2 autres LO
          With LO
               For i = .ListRows.Count To 1 Step -1     'commencer avec le dernier et reculer
                    If StrComp(.DataBodyRange(i, 3).Value, "oui", vbTextCompare) = 0 Then
                         r = "x"     'commencer avec r as string
                         If LO_Synthese.ListRows.Count <> 0 Then r = Application.Match(.DataBodyRange(i, 1), LO_Synthese.ListColumns("Column1").DataBodyRange, 0)     'r=ligne correspondant dans lo_synthese
                         If Not IsNumeric(r) Then     'ligne correspondant n'est pas trouvée
                              LO_Synthese.ListRows.Add     'ajouter nouvelle ligne dans lo_synthese
                              r = LO_Synthese.ListRows.Count     'r=derniere ligne
                         End If
                         LO_Synthese.ListRows(r).Range.Value = LO.ListRows(i).Range.Value     'copier les valeurs vers lo_synthese
                         LO.ListRows(i).Delete
                    End If
               Next
          End With
     Next
End Sub

Merci beaucoup pour vos repenses

pour le macro 2 de ThauThème marche bien le seul probleme c'est quond je click pour la 2eme fois il recopier le tableau des le debut

par contre je veux apres lajoute dune nouvelle ligne avec la condition "oui" je click pour la 2eme fois++ il copier juste cette derniere ligne ajoutee sur le 2eme tableau Merci

Bonjour le fil, bonjour le forum,

Puisqu'il recopie tout le tableau ça revient au même sauf l'ordre qui n'est pas respecté. Mais si tu veux cela il faudra ajouter un marqueur qui permettra de repérer les ligne déjà préalablement copiées. Dis-moi...

j'ai revérifié, OUI il marche tres bien Merci beaucoup pour vos repenses

Re,

En pièce jointe ton fichier modifié, l'ordre est respecté et le marqueur est la police en gras quand la copie est faire...

ah parfait, un grand grand merci

re,

la moitié des macros est definir le truc, faitez-cela dans un macro commun, est pourquoi declarer les feuilles, quand c'est uniquement les listobjects qui t'intéressent ? Un listobject est vraiment un outil facile à manipuler.

Option Explicit

Private O1 As Worksheet, O2 As Worksheet, O3 As Worksheet     'déclare la variable O3 (Onglet 1)
Private T1 As ListObject, T2 As ListObject, T3 As ListObject     'déclare la variable T3 (Tableau structuré 3)

Sub Commun(b)
     If b Then     'si vrai = definir ces variables
          Set O1 = Worksheets("Sheet1")     'définit l'onglet O1
          Set O2 = Worksheets("Sheet2")     'définit l'onglet O2
          Set O3 = Worksheets("Sheet3")     'définit l'onglet O3
          Set T1 = O1.ListObjects(1)     'définit le tableau structuré T1
          Set T2 = O2.ListObjects(1)     'définit le tableau structuré T2
          Set T3 = O3.ListObjects(1)     'définit le tableau structuré T3
     Else     'si faux reset ces variables
          Set O1 = Nothing
          Set O2 = Nothing
          Set O3 = Nothing
          Set T1 = Nothing
          Set T2 = Nothing
          Set T3 = Nothing
     End If
End Sub

Sub Macro1()
     Dim I     As Integer     'déclare la variable I (Incrément1)
     Dim J     As Integer     'déclare la variable J (incrément)

     Commun True

     For I = T2.ListRows.Count To 1 Step -1     'boucle 1 : inversée sur toutes les ligne I de T2 (de la dernière à la première)
          For J = 1 To T1.ListRows.Count     'boucle 2 : sur toutes les ligne J de T1
     'si la donnée ligne J colonne 1 de T1 est égale à la donnée ligne I de T2, supprime la ligne J de t1
               If T1.DataBodyRange(J, 1) = T2.DataBodyRange(I, 1) Then T1.ListRows(J).Delete
          Next J     'prochaine ligne de la boucle 2
     Next I     'prochaine ligne de la boucle 1

     Commun False

End Sub

Bonjour le fil, bonjour le forum,

@BsAlv, j'ai peur pour les mouches...

shopping

okay, bonne après-midi ...

Merci a vous

Rechercher des sujets similaires à "verifier supprimer ligne"