XL 2016 Macro pour compiler fichiers excel + Macro pour empiler tableaux

[razorlight]

Bonjour à tous,

Je vous prie d'avance de m'excuser si le sujet a été traité, j'ai eu beau chercher je n'ai pas trouvé de solution à la problématique à laquelle je fais face.
Voici la situation de départ : je reçois régulièrement une 30aine de fichiers XLS, identique sur la forme (colonne).
Régulièrement, j'ouvre un par un ces fichiers et copie la feuille contenant le tableau pour incrémenter un fichier excel "récapitulatif".

Puis, sur mon nouveau fichier excel "récapitulatif" composé de ma 30aine d'onglets, je crée un onglet "synthèse" et compile chaque tableau de chaque onglet.

Bref, c'est long et fastidieux et terriblement frustrant quand on connait les capacités de l'outil VBA. Je précise, je travail sur EXCEL 2016.


Afin de décomposer mon travail j'aimerais créer 2 macro que je nommerai "Rassembler" pour la fonction de rassembler les 30 fichiers excel en un seul fichier excel composé de 30 onglets (appelé RECAP) puis une autre permettant la création d'un onglet "synthèse" avec les 30 tableaux compilés.
J'espère avoir été clair . Pour anticiper la question, oui la même information apparaitrait 2 fois dans le même document, mais c'est utile pour moi de le conserver (même si je sais que les filtres peuvent m'aider à isoler et que ça alourdira le document).

Je ne sais pas du tout comment créer la première MACRO "Rassembler", j'ai trouvé ça sur une autre discussion ;

Sub RASSEMBLER()

Dim Chemin As String
Application.ScreenUpdating = False
Chemin = "C:\chemin"
Ouvrir Chemin
Application.ScreenUpdating = True
If msg <> "" Then _
MsgBox "Pour des raisons de protection ou autres, n'ont pu être copiées " & vbCrLf & msg
End Sub

Sub Ouvrir(Chemin As String)
Dim NomFich As String
Dim CL2 As Workbook 'fichier copié
Application.DisplayAlerts = False 'Evite les messages d'Excel
'Evite l'exécution éventuelle de macros liées aux fichiers ouverts
Application.EnableEvents = False
NomFich = Dir(Chemin & "*.xls")
If NomFich = "" Then
MsgBox "Aucun fichier trouvé dans " & Chemin
Exit Sub
End If
Do While NomFich <> ""
Set CL2 = Workbooks.Open(Chemin & NomFich)
DoEvents
Copie CL2
CL2.Close False
DoEvents
ThisWorkbook.Save 'enregistrement du classeur après chaque copie
DoEvents
NomFich = Dir
Loop
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub


Sub Copie(CL2 As Workbook)
Dim LaFeuille As Worksheet, FL1 As Worksheet, derlig As Long
Set FL1 = ThisWorkbook.Worksheets("feuil1") 'feuille où les données sont collées
For Each LaFeuille In CL2.Worksheets 'parcours du classeur à copier
'On vérifie que la feuille n'est pas vide
If Not (LaFeuille.UsedRange.Address = "$A$1" And Range("A1") = "") Then
derlig = FL1.Range("A" & Rows.Count).End(xlUp).Row + 1 'première ligne vide
On Error Resume Next
LaFeuille.UsedRange.Copy FL1.Cells(derlig, 1)
DoEvents
If Err <> 0 Then
msg = msg & "Classeur " & NomFich & " feuille " & LaFeuile.Name & vbCrLf
On Error GoTo 0
End If
End If
Next
End Sub

Concernant la macro "Synthèse" j'ai essayé celle-ci mais qui n'a pas fonctionné car elle ne m'a copié que la 1ère feuille sans la deuxième plus bas.

Sub SYNTHESE()
'
' SYNTHESE Macro

Sheets(2).Range("a4:j" & Cells(Rows.Count, 2).End(xlUp).Row).Copy _
Destination:=Sheets(1).[a4]
Sheets(3).Range("a4:b" & Cells(Rows.Count, 2).End(xlUp).Row).Copy _
Destination:=Sheets(1).Cells(Rows.Count, 2).End(xlUp)(2)

End Sub

J'appelle à l'aide, petit débutant que je suis, pour une opération pas si complexe mais qui m'allègerait beaucoup la vie.
Je vous remercie.

 

[sylvanu]

Bonsoir Razorlight,
Je ne sais pas comment vous avait architecturé votre tableau Synthèse.
Testez cette petite macro :

Sub Longeur()
    MsgBox ("Dernière ligne de Date : " & Range("A" & Rows.Count).End(xlUp).Row)
End Sub

Il va vous répondre ... 1747 . Soit la fin de votre tableau.
Donc la ligne :

   Sheets(3).Range("a4:b" & Cells(Rows.Count, 2).End(xlUp).Row).Copy _
   Destination:=Sheets(1).Cells(Rows.Count, 2).End(xlUp)(2)

pose problème car votre tableau est structuré.

 

[sylvanu]

Re,
J'ai essayé moult solutions sans succès. Pour XL un tableau structuré est réservé, la première cellule libre est ... après le tableau.
Je vous propose ça. Pas très orthodoxe, mais ça marche.
Il doit y avoir des méthodes plus simples avec des tableaux structurés mais je ne connais pas.
Peut être que quelqu'un du forum sera plus inspiré.

 

[sylvanu]

Bonjour,
En PJ quelque chose de "plus propre".

Sub SYNTHESE()
    N = Compter(0)
    Sheets(2).Range("a4:j" & Cells(Rows.Count, 2).End(xlUp).Row).Copy _
   Destination:=Sheets(1).Range("a" & N)
    N = Compter(0)
   Sheets(3).Range("a4:j" & Cells(Rows.Count, 2).End(xlUp).Row).Copy _
   Destination:=Sheets(1).Range("a" & N)
End Sub
Function Compter(N)
Dim i
With Sheets("SYNTHESE").ListObjects("Tableau373")
    Compter = .ListColumns("Date").Range.Find("", SearchDirection:=xlNext).Row
End With
End Function

A noter que vous devez avoir un problème sur Tableau373. En MontantTTC ligne 114 vous avez un sous total : SOUS.TOTAL(9;Tableau374[Montant TTC])

 

[sylvanu]

Re, et fin.
Juste pour la Fin. Je n'aime pas quand c'est pas réellement fini.
Le bouton de Synthèse récupère toutes les données de toutes les feuilles. ( J'ai supprimé le sous total en E114. S'il avait une utilité alors récupérer uniquement la macro )

 

[James007]

Bonjour le fil,

Pour consolider tout ce que l'on veut très facilement : Power Query

Power Query : Combiner plusieurs fichiers Excel

Le CFO masqué vous enseigne comment combiner des fichiers Excel avec l'aide de Power Query, illustration détaillée pas à pas.

www.lecfomasque.com

En espèrant que cela t'aide

 

[sylvanu]

Bonjour Razorlight , James,
Malheureusement je ne dispose que d'XL2007 et je n'ai pas trouver d'addon pour Power Query.
Donc je n'ai apporté qu'une solution qui est à ma portée. Désolé.
Razorlight , vous avez une solution de plus à votre problème.

 

[James007]

Bonjour,

Effectivement, ce n'est que... depuis 10 ans, (à partir d'Excel 2010) ...que l'on peut installer l'add-in Power Query (Récupérer et Transformer )

 

[razorlight]

Merci Sylvanu pour toutes ces réponses ! J'ai jeté un oeil sur la Macro "synthèse" et elle fonctionne à merveille ! J'ai même réussi à la modifier pour intégrer de nouvelles colonnes et l'adapter complètement à mon outil. Merci beaucoup !
Sylvanu, James, merci pour le conseil mais le réseau professionnel sur lequel je travaille est bloqué. Je ne pourrai pas ajouter d'add-on même s'il provient de sites sources fiables.

 

[razorlight]

Bonjour.
Je remonte ce sujet.

J'essaie une nouvelle fois d'unifier plusieurs Workbook excel en un seul.
J'ai essayé de mon côté plusieurs choses mais j'avoue que le monde VBA reste encore très flou pour moi.
Pour cela je suis reparti sur mon fichier et j'y ai ajouté 2 macros, la première me sert uniquement à ajouter des onglets dans le fichier.

Je suis désolé d'avance pour vos yeux, j'ai tenté quelques chose d'un peu barbare.

Sub creeronglets()

'############### Creer onglets ##################

Dim i As Long, nbfeuilles As Long
nbfeuilles = InputBox("combien d'onglets a creer?")
For i = 1 To nbfeuilles
Sheets.Add after:=Sheets(Worksheets.Count)
With ActiveSheet
.Name = "Feuil" & i + 1
.Range("a1") = "Ville"
End With
Next

End Sub

La deuxième macro doit permettre de copier-coller les informations. En la testant j'ai réussi à copier-coller une feuille et j'ai donc essayé de faire une boucle en copiant collant 40 fois la boucle en modifiant à chaque fois le nom du fichier d'origine….

Sub copier_coller()
'############### Copier les donn?es dans d'autres classeurs ##################
Dim wkDest As Workbook ' Classeur destinataire
Dim wOrigBureau104 As Workbook
Dim wOrigBureauA105 As Workbook
'Dim x40 bureaux !!

'definition du classeur Bureau104.xlsx pour r?cup?ration des donn?es
Set wOrigBureau104 = Application.Workbooks.Open("C:\Users\SurfacePro\Documents\Bureau104.xlsx")
wOrigBureau104.Sheets("Feuil1").Cells.Copy wkDest.Sheets("Feuil2").Range("A1")
wOrigBureau104.Close True 'Fermer document copié

'definition du classeur Bureau105.xlsx pour recuperation des donnees
Set wOrigBureau105 = Application.Workbooks.Open("C:\Users\SurfacePro\Documents\Bureau105.xlsx")
wOrigBureau105.Sheets("feuil1").Cells.Copy wkDest.Sheets("Feuil3").Range("A1")
wOrigBureau105.Close True 'Fermer document copié

'et ces 3 mêmes lignes copier 40 fois !!!

End sub

Message d'erreur "Variable objet non définie (Erreur 91)".
Je sais que cette manip demande un strict respect des titres (noms des fichiers excel et noms des feuilles du fichier excel de destination) mais c'est réalisable.
En revanche, contrairement à l'exemple, les numéros de "Bureau" ne se suivent pas.
Pourriez-vous m'aider une fois de plus svp ?

Et désolé d'avance, mon niveau est bas et j'essaie pourtant de me lancer dans des formules complexes.

 

[razorlight]

Up ?

 

[StephGuerain]

Avec Excel 2016 Power Query fait très bien le boulot plus besoin de macro pour ça

 

[Danixdb]

Bonjour razorlight, Le Forum,

Effectivement, comme cela a été dit Power query est parfaitement adapté à ce type de demande et en pièce jointe, le résultat que cela donne. Power query est natif à partir d'Excel 2016 et par macro complémentaire pour la version 2013.
Dans un premier temps, chaque tableau de chacun des sites doit être nommé tabNomDuSite (ex : tabChaumont).
Ensuite dans la feuille Synthèse, il ne reste plus qu'à rafraîchir le tableau en allant dans le menu Donée, Actualiser tout ou avec un clic droit de la souris, choisir l'option Actualiser.
En espérant que cela te simplifiera la tâche
Cordialement
DanixDB

 

[razorlight]

Bonjour, comme je l'ai dit plus haut, je travaille sur un réseau professionnel sur lequel je ne peux pas installer d'add-in. Malheureusement, cette solution, bien que pouvant me simplifier la vie n'est pas faisable techniquement .

 

[Staple1600]

Bonjour le fil,

Bonjour, comme je l'ai dit plus haut, je travaille sur un réseau professionnel sur lequel je ne peux pas installer d'add-in. Malheureusement, cette solution, bien que pouvant me simplifier la vie n'est pas faisable techniquement .

[POUR INFOS]
C'est un add-on fourni par Microsoft.
Personnellement, à mon taf*, j'ai demandé à la DSN que ce soit installé et ce fut le cas.
C'est une fonctionnalité officielle de Microsoft , pas un add-on tiers.

*: avec réseau et Sharepoint également.