copie ligne sous condition

[limagerit]

Bonsoir a tous,

Je viens crier au secour pour une copie de plusieurs onglets soumis à condition.
J'ai lu les differents postes et ne trouve pas mon bonheur.

voici la problèmatique

source : plusieurs onglets avec une liste
objectif : cumuler les lignes dans 1 nouveau onglet selon le critere oui

j'ai essayé les piste vba et les matricielles
mais rien n'y fit

ci joint un petit ex

Merci du coup de pouce et bonne fete de paques a tous.

 

[Robert]

Re : copie ligne sous condition

Bonsoir Limagerit, bonsoir le forum,

En pièce jointe ton fichier modifié et commenté. La macro vérifie l'existence d'un onglet nommé Cumul. Si il n'existe pas, elle le crée en fin de classeur et copie dans celui-ci toutes les lignes contenant oui. Si il existe, elle copie toutes les lignes contenant oui. J'espère que j'avais bien compris ton problème...

Le code :

Sub Macro1()
Dim ong As Worksheet 'déclare la variable ong (ONGlet)
Dim pl As Range 'déclare la variable pl (PLage)
Dim dest As Range 'déclare la variable dest (DESTination)
 
'vérification de l'existance de l'onglet "Cumul"
For Each ong In Sheets 'boucle sur tous les onglets du classeur
    If ong.Name = "Cumul" Then GoTo suite 'si le nom de l'onglet est "cumul" va à l'étiquette "suite"
Next ong 'prochain onglet de la boucle
 
Sheets.Add after:=Sheets(Sheets.Count) 'ajoute un nouvel onglet à la fin
ActiveSheet.Name = "Cumul" 'nomme l'onglet "Cumul"
Sheets("frigo").Rows(1).Copy Sheets("cumul").Range("A1") 'récupère les en-tête de la première ligne
Sheets("cumul").Range("F1") = "Origine" 'écrit "Origine" en F1 (à supprimer si pas nécessaire)
 
suite: 'étiquette
For Each ong In Sheets 'boucle 1 : sur tous les onglets du classeur
    If ong.Name <> "Cumul" Then 'condition 1 : si le nom de l'onglet est différent de "Cumul"
        Set pl = ong.Range("E2:E" & ong.Range("E65536").End(xlUp).Row) 'définit la plage pl
        For Each cel In pl 'boucle 2 : sur toutes les cellule cel de la plage pl
            If cel.Value = "oui" Then 'condition 2 : si la valeur de la cellule est "oui"
                Set dest = Sheets("Cumul").Range("A65536").End(xlUp).Offset(1, 0) 'définit la cellule de destination
                cel.EntireRow.Copy dest 'copie la ligne entière de la cellule cel dans la cellule de destination dest
                dest.Offset(0, 5).Value = ong.Name 'écrit dans la colone F l'origine de la copie (à supprimer si pas nécessaire)
            End If 'fin de la condition 2
        Next cel 'prochaine cellule cel de la boucle 2
    End If 'fin de la condition 1
Next ong 'prochain onglet de la boucle 1
 
End Sub

le fichier :

 

[Efgé]

Re : copie ligne sous condition

Bonsoir limagerit, Robert,
Bien en retard, et moins bon que Robert, mais comme je l'ai fait, je le poste...

Sub test()
Application.ScreenUpdating = False
Dim f As Worksheet
Dim Lig As Long
Dim Lig2 As Long
Sheets("Recap").Range("A2:F1000").ClearContents
For Each f In ThisWorkbook.Worksheets
    If f.Name <> "Recap" Then
        f.Activate
            For Lig = 2 To f.Range("E65536").End(xlUp).Row
                If f.Cells(Lig, 5).Value = "oui" Then
                    Cells(Lig, 1).EntireRow.Copy
                    Lig2 = Sheets("Recap").Range("E65536").End(xlUp).Row + 1
                    Sheets("Recap").Activate
                    Rows(Lig2 & ":" & Lig2).Select
                    Selection.Insert Shift:=xlDown
                    Cells(Lig2, 6).Value = f.Name
                    f.Activate
                End If
            Next Lig
    End If
Next f
Sheets("Recap").Activate
Range("A1").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Cordialement

 

[limagerit]

Re : copie ligne sous condition

Grand merci à tous les deux

J'ai testé les deux solutions car je suis toujours curieux de comprendre.
merci pour les details dans les macros cela m'aide à comprendre la logique.


Au plaisir de vous lire et de vous aider un jour à mon tour

Bonne fête du chocolat