Microsoft 365 Consolidation à partir de plusieurs classeurs fermés

[ivan27]

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

 

[chris]

RE

Changer le chemin dans la cellule en jaune et Données, Actualiser Tout

Tu me dis

 

[ivan27]

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]

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

 

[David Aubert]

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]

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

 

[David Aubert]

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

 

[chris]

Bonjour David

Oui c'est très pratique : on modélise sur un cas puis on transforme en fonction.

 

[job75]

Bonjour à tous,

Une solution simple consiste à créer des formules de liaisons :

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+

 

[chris]

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...

 

[job75]

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.

 

[chris]

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...

 

[job75]

Si l'on ne connaît pas le nom des feuilles en VBA il faut ouvrir chaque fichier, voyez ce fichier (2) :

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

 

[chris]

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]

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]

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 N° 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.