Copier des lignes en fonction d'un critère dans une autre feuille

Bonjour à vous,

J'ai un classeur Excel avec trois feuilles (BD, Oui, Non)

Dans ma feuille BD je souhaite copier mes données qui répondent au critère "Oui" dans la feuille "Oui" et copier mes données qui répondent au critère "Non" dans la feuille "Non".

Je n'arrive pas à trouver la solution pour répondre à ma problématique.

NB : Dans ma feuille BD j'ai déjà du code VBA qui totalise toutes mes valeurs qui répondent aux critères Oui et Non

Je vous joins la feuille.

Si une bonne âme a une réponse alors grand merci.

Bonjour,

Si j'ai bien compris ...

Un essai ...

Sub calcul()
'Pour le calcul des CA Oui
Dim Celoui As Range, Cel1 As Range
Dim Celnon As Range, Cel2 As Range
Dim Dlig As Long
Dim ShO As Worksheet
Dim ShN As Worksheet
Dim DlO As Integer, DlN As Integer

Set ShO = Worksheets("Oui")
Set ShN = Worksheets("Non")

    'Calcul des CA Oui et du compteur des CA Oui
    'On affecte la plage de cellules ("E7:E1331") à la variable CelOui

    Dlig = Worksheets("BD").Cells(Rows.Count, "A").End(xlUp).Row

    Set Celoui = Range("D2:D" & Dlig)
    'Pour chaque cellule de la plage de cellule
    Range("G2:J2").ClearContents

    For Each Cel1 In Celoui
        If Cel1 = "Oui" Then
            Cells(2, "G") = Cells(2, "G") + Cells(Cel1.Row, 3)
            Cells(2, "H") = Cells(2, "H") + 1
            DlO = Worksheets("Oui").Cells(Rows.Count, "A").End(xlUp).Row + 1
            Range("A" & Cel1.Row & ":C" & Cel1.Row).Copy ShO.Range("A" & DlO & ":C" & DlO)
        End If
    Next Cel1

    'Calcul des CA Non et du compteur des CA Non
    'On affecte la plage de cellules ("E7:E1331") à la variable CelOui
    Set Celnon = Range("D2:D" & Dlig)
    'Pour chaque cellule de la plage de cellule
    For Each Cel2 In Celnon
        If Cel2 = "Non" Then
            Cells(2, "I") = Cells(2, "I") + Cells(Cel2.Row, 3)
            Cells(2, "J") = Cells(2, "J") + 1
            DlN = Worksheets("Non").Cells(Rows.Count, "A").End(xlUp).Row + 1
            Range("A" & Cel2.Row & ":C" & Cel2.Row).Copy ShN.Range("A" & DlN & ":C" & DlN)
        End If
    Next Cel2
End Sub

ric

Bonjour,

Ouupppssss! J'ai zappé le 2e partie > copier dans les feuilles.

Je reviens.

ric

Bonjour,

J'ai modifié le code précédent ...

Espérant qu'il te convienne ...

ric

C'est super.

Ton code marche impec !!!

Grand merci pour ton aide et bravo

Bonjour Ric,

Je fais suite à ton coup de main qui m'a été fort utile et je t'en remercie.

Question :

Quand j'exécute le code celui ci ne tient pas compte des cellules déjà renseignées dans les feuilles Oui et Non. Ce qui veut dire que si j'exécute le code 5 fois alors j'aurai 5 fois les mêmes noms dans mes feuilles Oui et Non.

Peut-on copier les valeurs dans les feuilles respectives en tenant compte des valeurs déjà collées dans les feuilles Oui/Non (éviter les doublons) et allant se coller dans la ligne immédiatement dispo.

Grand merci d'avance.

PS : Je te retransmets le fichier Excel en question

Bonjour,

Good, je te tricote cela ... si personne ne passe avant ...

ric

Merci

A+

Bonjour,

Un essai ...

ric et Christophe sont prêts pour le test ...

ric

Salut RIC

Cela marche très bien

Bravo et Merci.

Encore bravo RIC,

Ton code est efficace et particulièrement performant.

Tout ton code n'est pas sujet à commentaire loin s'en faut mais la partie ci-dessous mérite quelques commentaires pour le béotien que je suis même si je pratique un peu. Peux tu m'éclairer

ReDim TablO(Dlig2 - 2, 2)

For i = 0 To Dlig2 - 2

TablO(i, 0) = ShO.Range("A" & i + 2)

TablO(i, 1) = ShO.Range("B" & i + 2)

TablO(i, 2) = ShO.Range("C" & i + 2)

Next i

For i = 0 To UBound(TablO)

If ShBd.Cells(Cel1.Row, 1) = TablO(i, 0) And ShBd.Cells(Cel1.Row, 2) = TablO(i, 1) And ShBd.Cells(Cel1.Row, 3) = TablO(i, 2) Then

Exit For

Else

If ShBd.Cells(Cel1.Row, 1) <> TablO(i, 0) And i = UBound(TablO) Then

ShBd.Range("A" & Cel1.Row & ":C" & Cel1.Row).Copy ShO.Range("A" & Dlig2 + 1 & ":C" & Dlig2 + 1)

Voila voila

A+

ric

Bonjour,

On a eu un tir croisé ...

J'ai changé le fichier précédent ... il contient les commentaires demandés.

Si ce n'est pas suffisant ... demande ...

ric

Grand merci.

Je regarde tout ça en essayant de comprendre la logique du code.

A+

Merci pour ton partage de tes connaissances.

Tes commentaires sont très clairs