Extraction Multicritère depuis Multifeuille vers 1 dossier

Bonjour à tous.

J'espère que vos lumières pourront m'aider une fois encore et d'avance merci à ceux d'entre vous qui m'aideront !

J'ai 2 classeurs :

wA : classeur de destination

wB : classeur source

Le classeur wB s'enrichit d'une nouvelle feuille régulièrement (1jour sur 2 en moyenne).

Toutes les feuilles de wB à partir de la seconde sont construite sur le même modèle et comportent au maximum 3000 lignes. Leur nom commence toujours par PV avec nombre par ordre croissant...

Chacune de ces feuilles voit son contenu en colonne "H" réactualiser en fonction des modifications d'un tableau sur la première feuille (1jour sur 2 en moyenne)

Actuellement j'ai 190 feuilles. Donc présentement les données à extraire sont dans les feuilles "PV 01" à "PV 190".

(la première feuille est une feuille où se trouve divers tableaux pour remplir les feuilles suivantes)

Le classeur wA regroupe les données extraites du classeur wB avec 2 critères de sélection.

Jusqu'à ce jour je sélectionnait avec des filtres dans wB et copier/coller dans wA manuellement...

je ne peux plus... trop long... et puis plus le temps (j'essaie d'apprendre vba !!! et ses multiples propriétés, fonctions, sub... ) ...

Alors voici ce que je souhaiterai réaliser via macro après l'ouverture de wA

Désactiver la mise à jour de l'écran au début de l'exécution de la macro (ça c'est déjà fait et c'est ok)

Effacer les données contenue dans les différentes feuilles de wA avant de récupérer les données de wB mises à jour. (ça c'est déjà fait et c'est ok)

Ouvrir wB (ça c'est déjà fait et c'est ok)

Bon, et c'est maintenant que je n'arrive pas ... J'ai bien essayer en adaptant certains codes trouvé ici ces derniers jours mais j'ai toujours une erreur où une autre... je suis pas très douée... je l'avoue... donc :

Dans le classeur wB pour chacune des feuilles commençant par "PV.." : Chercher et sélectionner les lignes où la cellule dans la colonne "H" = "Fab" et la cellule dans la colonne "A" = "AA" ;

Copier les lignes sélectionnée de la colonne "A" à "G" puis coller dans la feuille "AA" du classeur wA à partir de la première ligne vide et colonne vide.... Enfin, je souhaite que les résultats trouvés dans PV 02 soit collés directement en dessous des résultats trouvés dans PV 01... etc. jusqu'au derniers résultats de la dernière feuille "PV..." et que le premier résultat de la première feuille "PV.." soit sur la ligne 2 à partir de la colonne "A"

Dans le classeur wB pour chacune des feuilles commençant par "PV.." : Chercher les lignes où la cellule dans la colonne "H" = "Fab" et la cellule dans la colonne "A" = "AB" ;

Copier les lignes valides de la colonne "A" à "G" puis coller dans la feuille "AB" du classeur wA à partir de la première ligne vide.... .... Enfin, je souhaite que les résultats trouvés dans PV 02 soit collés directement en dessous des résultats trouvés dans PV 01... etc. jusqu'au derniers résultats de la dernière feuille "PV..." et que le premier résultat de la première feuille "PV.." soit sur la ligne 2 à partir de la colonne "A"

Dans le classeur wB pour chacune des feuilles commençant par "PV.." : Chercher les lignes où la cellule dans la colonne "H" = "Fab" et la cellule dans la colonne "A" = "AC" ;

Copier les lignes valides de la colonne "A" à "G" puis coller dans la feuille "AC" du classeur wA à partir de la première ligne vide.... .... Enfin, je souhaite que les résultats trouvés dans PV 02 soit collés directement en dessous des résultats trouvés dans PV 01... etc. jusqu'au derniers résultats de la dernière feuille "PV..." et que le premier résultat de la première feuille "PV.." soit sur la ligne 2 à partir de la colonne "A"

Bon je vais pas plus loin car en fait j'ai dans le classeur wA 50 feuilles à remplir depuis wB...

Activer la mise à jour de l'écran à la fin de l'exécution de la macro (ça c'est déjà fait et c'est ok)

Bon, j'ai bien compris qu'il est question de système d'encodage "For Next" , "For Each Next" et "If"... Cependant je n'arrive pas...

Je vous joint extrait des 2 classeurs avec la partie du code qui fonctionne... et espère que vous pourrez m'aider...

Encore merci d'avance ...

Belle journée à tous et toutes...

Lilly

Bonjour à Tous !

Alors j'ai trouvé une solution un peu lourde à mon petit tracas de code VBA...

Il est certain que cela n'est pas le top... Alors si vous avez mieux je suis toujours preneuse...

PS : Pour effacer mes feuilles la ligne d'en-tête est aussi effacer sur les pages suivant la première... Bon ce n'est pas un détail important mais là aussi il doit y avoir un petit truc que j'ai pas compris....

Alors voici le code trouvé... et merci à ceux qui peuvent le rendre plus digeste...

Belle Journée à Tous...

Sub Test1()

Dim wA As Workbook 'classeur de destination

Dim wB As Workbook 'classeur source

Dim ws As Worksheet 'feuilles du classeur wA

Dim I 'feuilles du classeur wB à passer en revue avant copier coller dans wA

Dim dlR& 'plage à effacer dans wA avant exécution extraction de données de wB

Dim Cel As Range

Dim wsAAA As Worksheet 'Feuille "AA" de wA

Dim wsAAB As Worksheet 'Feuille "AB" de wA

Dim wsAAC As Worksheet 'Feuille "AC" de wA

Application.ScreenUpdating = False

Set wA = ThisWorkbook

Set wB = Application.Workbooks.Open("C:\Users\marie-lilly\Documents\Test macro\wB.xlsm", , True)

With wA

For Each ws In .Worksheets

dlR = ws.Range("A" & Rows.Count).End(xlUp).Row

ws.Range("A2:AZ" & dlR).ClearContents

Next ws

End With

Set I = wB.Worksheets

Set wsAAA = wA.Worksheets("AA")

Set wsAAB = wA.Worksheets("AB")

Set wsAAC = wA.Worksheets("AC")

For I = 2 To Worksheets.Count

With Worksheets(I)

For Each Cel In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)

If Cel.Offset(0, 7) = "Fab" And Cel.Offset(0, 0) = "AA" Then

Cel.Resize(1, 7).Copy wsAAA.Range("A" & Rows.Count).End(xlUp).Offset(1)

End If

Next Cel

For Each Cel In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)

If Cel.Offset(0, 7) = "Fab" And Cel.Offset(0, 0) = "AB" Then

Cel.Resize(1, 7).Copy wsAAB.Range("A" & Rows.Count).End(xlUp).Offset(1)

End If

Next Cel

For Each Cel In .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row)

If Cel.Offset(0, 7) = "Fab" And Cel.Offset(0, 0) = "AC" Then

Cel.Resize(1, 7).Copy wsAAC.Range("A" & Rows.Count).End(xlUp).Offset(1)

End If

Next Cel

End With

Next I

Set wsAAA = Nothing

Set wsAAB = Nothing

Set wsAAC = Nothing

Application.ScreenUpdating = True

End Sub

Bonjour,

A vouloir trop généraliser, on arrive à un exemple un peu suspect...

Je suppose que la liste des feuilles est en fait la liste des REF qu'on trouve dans wA ? Et que cette liste n'a rien à voir avec AA, AB, AC...

Si c'est le cas la macro suivante devrait être correcte.

Je n'ai pas pu trop tester car tes classeurs sont trop rudimentaires... mais pour AA, AB AC ça me semble correct.

Option Explicit

Sub Galopin()
Dim i%, ii%, iNBRef%, iLRC%, iLRef%, iLRS%, k%, x%, iP$, o, ArrP, Tablo
Dim WbC As Workbook 'classeur Cible (wA)
Dim WbS As Workbook 'classeur Source

Application.ScreenUpdating = False
Set WbC = ThisWorkbook
With WbC
   For Each o In .Worksheets
     iLRC = o.Range("A" & Rows.Count).End(xlUp).Row
     o.Range("A2:AZ" & iLRC).ClearContents
   Next
End With

Set WbS = Application.Workbooks.Open("C:\Users\marie-lilly\Documents\Test macro\wB.xlsm", , True) 'Workbooks("wB.xlsm")
'WbS est le classeur actif !
iLRef = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row - 1
'ArrP est untableau qui contient la liste des Ref (feuilles cibles)
ArrP = Worksheets(1).Range("A2:A" & iLRef + 1)

For ii = 1 To iLRef 'Pour chaque référence
iP = ArrP(ii, 1)
   For i = 2 To Worksheets.Count  '...et pour chaque feuille du classeur source
      iLRS = Range("A" & Rows.Count).End(xlUp).Row - 1
      'Tablo contient les 8 premières colonnes de chaque feuille)
      Tablo = Worksheets(i).Range("A2:H" & iLRS + 1)
      For k = 1 To iLRS            'on parcoure chque ligne du Tablo source
         If Tablo(k, 8) = "Fab" And Tablo(k, 1) = iP Then
            'Si la condition est vérifié, on copie les données...
            With WbC.Worksheets(iP)
               iLRC = .Range("A" & .Rows.Count).End(xlUp)(2).Row
               For x = 1 To 7
                  .Cells(iLRC, x) = Tablo(k, x)
               Next
            End With
         End If
      Next
   Next
Next
Application.ScreenUpdating = True
End Sub

A+

Bonsoir Galopin

Merci pour ton aide précieuse... ...

Oui... Ce n'est pas évident de garder le côté confidentiel du fichier... ... sans être trop vague...

En réalité là il est question de petit artisanat associatif afin de permettre à certaines d'entre nous de "mettre du beurre dans les épinards"... voir même manger des épinards tout court...

les 5 premières colonnes du fichier source sont des articles différents ... et les 2 suivantes des conditionnements...

Chaque ligne est donc un lot de 5 articles en deux conditionnement possible...

L'article dans la colonne A est celui qui prédomine et définie les lots à relancer en fabrication puis conditionnement....

Au total il y a 50 articles différents possible dans cette colonne A... Ce qui me donne 50 feuilles donc pour le classeur destination...

Donc, je vais prendre ce beau cadeau de code... et le tester sur une copie des vrais fichiers...

Encore merci pour ton aide....

Et si je n'ai pas l'opportunité de venir d'ici mercredi... Je te souhaite de belles fêtes de fin d'années