Microsoft 365 Consolidation à partir de plusieurs classeurs fermés

ivan27

XLDnaute Occasionnel
Bonjour à tous,

Sur mon bureau un répertoire ''test'' contenant plusieurs classeurs nommés ''facture1", "facture2", etc...
J'ai un classeur ouvert "BD" et je souhaite consolider sur la feuille active, tous les onglets des classeurs fermés.
La consolidation porte uniquement sur les cellules E14, J11 et J16.
Je vous communique en pièce jointe le résultat attendu.
Merci d'avance pour votre aide
Bonne journée et bon week-end,
Ivan
 

Pièces jointes

  • test.zip
    25.3 KB · Affichages: 15
Solution
RE

J'ai modifié la requête pour que les fichiers facture5 et facture6 de job75,
qui semblent plus correspondre au cas réel que facture3 et facture4 postés par ivan27
ne provoquent pas l'erreur signalée au #17

Le temps d'exécution sur 50 classeurs est nettement plus rapide que VBA

ivan27

XLDnaute Occasionnel
Bonsoir chris,
Merci pour cette proposition.
Ca fonctionne bien avec le fichier test (version sans la colonne supplémentaire)
Par contre je n'arrive pas à le faire fonctionner sur mon fichier réel.
J'ai cette erreur :
''Expression.Error : Désolé... Nous n'avons pas trouvé la colonne « 2 » de la table.''
Ivan
 

chris

XLDnaute Barbatruc
RE

J'ai testé sur les 2 exemples de fichiers et même un 3ème ou j'ai mélangé des onglets avec et sans la colonne en plus et je n'ai pas de PB

Sans doute que les exemples ne sont pas identiques aux réels... ou il y a des classeurs autres que des factures dans la dossier
 
Dernière édition:

David Aubert

XLDnaute Barbatruc
Administrateur
Modérateur
Bonjour à tous,
Effectivement Chris a bien fait de le préciser.
Dans le cas de ta demande, il est important de respecter un certain process, car la solution technique ne peut anticiper les changements de structure des fichiers.
Il faut effectivement aussi qu’il n’y ait que des factures et rien d’autre dans le dossier.
Je ne sais pas si cette demande ne concerne que toi ou une équipe de travail.
Si elle ne concerne que toi, c’est à toi de suivre ces « règles » et tu vas gagner du temps.
Si c’est une équipe, rédige ou explique simplement comment tes collègues/collaborateurs doivent fonctionner pour que ça marche.
Bon Dimanche
David
 

ivan27

XLDnaute Occasionnel
Bonjour le forum, chris, David,
chris, tu as raison, l'erreur vient bien de moi, j'ai abusé du copier/coller en anonymisant les fichiers ce qui a entraîné une modification de leurs structures. Désolé....
Si tu veux bien adapter la requête de ton côté, je te communique en pièce jointe 2 autres fichiers que je viens d'effacer à la main !
David, effectivement ce sont des collaborateurs qui utiliseront quotidiennement cette fonctionnalité et il bénéficieront bien d'une formation préparatoire.
Bonne journée à tous et encore merci.
Ivan
 

Pièces jointes

  • facture5.xlsx
    12.9 KB · Affichages: 5
  • facture6.xlsx
    12.8 KB · Affichages: 4

David Aubert

XLDnaute Barbatruc
Administrateur
Modérateur
RE

J'ai testé sur les 2 exemples de fichiers et même un 3ème ou j'ai mélangé des onglets avec et sans la colonne en plus et je n'ai pas de PB

Sans doute que les exemples ne sont pas identiques aux réels... ou il y a des classeurs autres que des factures dans la dossier
Salut @chris, et tous,
Super l'appel à ta fonction "Transformer" dans Power Query, ça permet de bien alléger la requête "Factures"! :)
Bonne journée
David
 

job75

XLDnaute Barbatruc
Bonjour à tous,

Une solution simple consiste à créer des formules de liaisons :
VB:
Sub Consolider()
Dim chemin$, fichier$, ad$(1 To 3, 1 To 2), lig&, f$, n As Byte
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
fichier = Dir(chemin & "*.xls*") '1er fichier du dossier
ad(1, 1) = "D14": ad(1, 2) = "E14" 'adresses à adapter
ad(2, 1) = "I11": ad(2, 2) = "J11" 'adresses à adapter
ad(3, 1) = "I16": ad(3, 2) = "J16" 'adresses à adapter
Application.ScreenUpdating = False
Range("A2:C" & Rows.Count).ClearContents 'RAZ
lig = 1
While fichier <> ""
    If fichier <> ThisWorkbook.Name Then
        f = "='" & chemin & "[" & fichier & "]X'!" 'nom de feuille inconnu
        lig = lig + 1
        For n = 1 To 2
            Cells(lig, 1) = f & ad(1, n)
            Cells(lig, 2) = f & ad(2, n)
            Cells(lig, 3) = f & ad(3, n)
            If Cells(lig, 1) <> 0 And Cells(lig, 2) <> 0 And Cells(lig, 3) <> 0 Then Exit For
        Next
    End If
    fichier = Dir
Wend
Columns("A:C").AutoFit 'ajustement largeurs
End Sub
Pour tester téléchargez les fichiers joints dans le même dossier (le bureau).

Bon dimanche.

A+
 

Pièces jointes

  • BD(1).xlsm
    19.1 KB · Affichages: 8
  • facture5.xlsx
    12.8 KB · Affichages: 9
  • facture6.xlsx
    12.8 KB · Affichages: 7

chris

XLDnaute Barbatruc
RE
@job75
A noter que chaque classeur contient plusieurs onglets avec chacun un nom correspondant à la référence facture donc qui est différent à chaque fois et que la position des cellules varie à deux cas différents comme évoqué au #14...
 

chris

XLDnaute Barbatruc
Re
Les 2 cas différents ma solution en tient compte, mais s'il y a plusieurs onglets il faudra connaître leurs noms qui doivent être les mêmes pour tous les onglets.

Justement chaque nom est différent puisqu'il identifie une facture différente et, sauf erreur de ma part, ton code ne traite qu'un onglet par classeur...
 
Dernière édition:

job75

XLDnaute Barbatruc
Si l'on ne connaît pas le nom des feuilles en VBA il faut ouvrir chaque fichier, voyez ce fichier (2) :
VB:
Sub Consolider()
Dim chemin$, fichier$, ad$(1 To 3, 1 To 2), lig&, w As Worksheet, n As Byte
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
fichier = Dir(chemin & "*.xl*") '1er fichier du dossier
ad(1, 1) = "D14": ad(1, 2) = "E14" 'adresses à adapter
ad(2, 1) = "I11": ad(2, 2) = "J11" 'adresses à adapter
ad(3, 1) = "I16": ad(3, 2) = "J16" 'adresses à adapter
Application.ScreenUpdating = False
With Feuil1 'CodeName, à adapter
    .Range("A2:C" & .Rows.Count).ClearContents 'RAZ
    lig = 1
    While fichier <> ""
        If fichier <> ThisWorkbook.Name Then
            Workbooks.Open chemin & fichier
            For Each w In ActiveWorkbook.Worksheets
                lig = lig + 1
                For n = 1 To 2
                    .Cells(lig, 1) = w.Range(ad(1, n))
                    .Cells(lig, 2) = w.Range(ad(2, n))
                    .Cells(lig, 3) = w.Range(ad(3, n)).Value
                    If .Cells(lig, 1) <> "" And .Cells(lig, 2) <> "" And .Cells(lig, 3) <> "" Then Exit For
            Next n, w
            ActiveWorkbook.Close False
        End If
        fichier = Dir 'fichier suivant
    Wend
    .Columns("A:C").AutoFit 'ajustement largeurs
End With
End Sub
 

Pièces jointes

  • BD(2).xlsm
    19.8 KB · Affichages: 7
  • facture5.xlsx
    14.9 KB · Affichages: 7
  • facture6.xlsx
    14.9 KB · Affichages: 5

chris

XLDnaute Barbatruc
RE

J'ai modifié la requête pour que les fichiers facture5 et facture6 de job75,
qui semblent plus correspondre au cas réel que facture3 et facture4 postés par ivan27
ne provoquent pas l'erreur signalée au #17

Le temps d'exécution sur 50 classeurs est nettement plus rapide que VBA
 

Pièces jointes

  • Synthese3.xlsx
    24.1 KB · Affichages: 11

ivan27

XLDnaute Occasionnel
Bonjour à tous,
chris, sauf erreur de ma part, sur cette dernière version on ne récupère pas les bonnes cellules sur le classeur ''facture5''.
job75, merci d'avoir rejoint cette discussion et pour la remise de tes propositions.
Ivan
 

chris

XLDnaute Barbatruc
Bonjour à tous

Ceci est basé sur ce post
Oui c'est le cas, c'est ce que je viens de constater. Parfois j'ai une colonne supplémentaire avec ''N°" juste avant le numéro de facture.

C'est la présence de qui sert à repérer ce cas étant donné qu'avec des X partout rien ne permet de se repérer.

PowerQuery s'appuie sur la logique base de données plus puissante mais plus rigoureuse

Si les exemples ne correspondent à rien de réel ou contredisent tes affirmations, je ne sais pas faire.
 

Discussions similaires