Consolidation de plusieurs onglets de plusieurs fichiers selon un chemin
Bonjour à tous,
Je suis nouveau sur le forum et j'aimerai créer une macro qui me permette des consolider tous les onglets de tous les fichiers présent dans un folder et cela en sélectionnant l'année voulu.
Ex : en cochant 2020 et 2021 dans mon tableau, la macro copie le format de mon onglet "extract" et consolide tous les onglets de tous les fichiers se trouvant dans le folder 2020 (chemin défini également dans mon tableau) et me créer donc 2 onglets (1 pour 2020 et 1 pour 2021).
J'arrive bien à copier mon onglet "Extract" et à le renommer avec l'année mais je n'arrive pas à combiner cette copie avec la consolidation des données.
De plus, ma consolidation ne prends en compte que la feuille 1 de chaque fichier, elle ne prends pas tous les autres onglets. N'arrivant pas à faire marcher la fonction (For each Ws in Active.woorkbooks)
En espérant avoir été clair. Merci pour votre aide.
Bonjour, et bienvenue
essaie quelque chose comme ceci
il y a quelques réglages sans doute à faire
Sub Importer()
Application.ScreenUpdating = False
Set monWB = ActiveWorkbook
ChDrive "C:" ' Choix du lecteur
ChDir "C:\Users\Michel\Downloads"
w = Application.GetOpenFilename(, , , , True)
For i = 1 To UBound(w)
Workbooks.Open (w(i))
Set wb = ActiveWorkbook
For Each f In wb.Worksheets
f.UsedRange.Copy
Set ws = monWB.Sheets.Add(After:=monWB.Sheets(monWB.Sheets.Count))
ws.Paste
On Error Resume Next
ws.Name = Split(wb.Name, ".")(0) & "|" & f.Name
If Err Then
Debug.Print "Erreur " & Err & ", suppression de la feuille """ & Split(wb.Name, ".")(0) & "|" & f.Name & """ !"
Application.DisplayAlerts = False
monWB.Sheets(ws.Name).Delete
Application.DisplayAlerts = True
ws.Name = Split(wb.Name, ".")(0) & "|" & f.Name
End If
On Error GoTo 0
Next f
Application.CutCopyMode = False
wb.Close False
Next i
End SubBonjour Steelson,
Merci pour ta contribution et ta réactivité. Je vais tenter de l'adapter à mon besoin.
Il y a des choses à changer notamment sur le dynamisme du chemin, je ne veux pas l'inclure dans le code car il peut changer en fonction de la demande.
comme ceci alors
Dim MonRepertoire, Repertoire As FileDialog
Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire ..."
Repertoire.Show
If Repertoire.SelectedItems.Count = 0 Then Exit Sub
MonRepertoire = Repertoire.SelectedItems(1) & "\"Merci pour ce nouveau code mais cela ne correspond pas tout à fait à mon besoin.
Il faudrait que la macro puisse faire 2 consolidations d'après le chemin inscrit dans le fichier.
ex :
| x | A2019 | 1 | C:\Data\2019 | |||
| x | A2020 | 1 | C:\Data\2020 | |||
| x | A2021 | C:\Data\2021 |
Si je mets "1" pour A2019 elle va consolider tous les onglets de tous les fichiers se trouvant sur C:\Data\2019, idem pour 2020.
Je ne souhaite choisir le chemin à la main à chaque fois car il y a de nombreuses consolidation à faire.
;-)
ok, je pensais que tu voulais le choisir au moment du code,
donc si je comprends bien, c'est une feuille de paramétrage qui pilote la compilation ?
dans ce cas tu peux faire une boucle sur le premier code
Sub Importer()
Application.ScreenUpdating = False
Set monWB = ActiveWorkbook
ChDrive "C:" ' Choix du lecteur
For i = 4 To 14
If Feuil11.Cells(i, 8) = 1 Then
ledossier = Feuil11.Cells(i, 10).Value
ChDir ledossier
w = Application.GetOpenFilename(, , , , True)
For i = 1 To UBound(w)
' .................
Next i
end if
Next
End Subje te laisse faire ... mais n'hésite pas si tu as un difficulté
Exactement, j'ai une feuille de paramétrage qui pilote la compilation.
Peux-tu m'expliquer ce que fait ce code exactement ?
"chDir ledossier
w = Application.GetOpenFilename(, , , , True)
For i = 1 To UBound(w)"
il y a 2 fois la variable de contrôle For ...
Oui, pour le double i c'est une erreur de ma part que d'avoir assembler 2 bouts de code.
w = Application.GetOpenFilename(, , , , True)
permet une sélection multiple de fichiers dont les noms sont stockés sous forme d'array dans w ici
cela évite une sélection des fichiers un par un
mais on aurait pu se satisfaire de la sélection du dossier en effet
Je m'y perds un peu du coup ...
J'ai une autre question, est-ce que les 2 macros que j'ai envoyé en PJ dans mon 1er envoi sont exploitables ?
Dans l'une des macros j'arrive a consolider et dans l'autre j'arrive à copier l'onglet extract et a le nommer avec l'année choisie.
Est-ce qu'il ne serait pas judicieux de les combiner ?
Je souhaiterai dans un premier temps régler mon problème sur le fait que mon code ne lise que la 1ere feuille de chaque fichier excel et j'ai besoin qu'il consolide toutes les feuilles.
"Sub consolidate()
Dim wbks As Workbook, wbkc As Workbook, x As Variant
Dim Cheminfichier As String
Dim f As Object, Fso As Object, adr$
Set Fso = CreateObject("Scripting.FileSystemObject")
Set wbkc = ThisWorkbook
Application.ScreenUpdating = False
For Each f In Fso.GetFolder(Sheets("Consolidate").Range("C5").Value).Files
If Not f = ThisWorkbook.FullName And Not f Like "*~$*" Then
Set wbks = Workbooks.Open(f)
With wbks.Sheets(1)
.Range("B15:P15" & .Range("C10000").End(xlUp).Row).Copy wbkc.Sheets(3).Range("C100000").End(xlUp).Offset(1, 0)
wbks.Close 0
End With
End If
Next f
Application.ScreenUpdating = True
Je sais que c'est au niveau With wbks.Sheets(1) mais je n'arrive pas à trouver la bonne formule ...il me manque toujours une donnée pour faire tourner le code.
essaie ceci
If Not f = ThisWorkbook.FullName And Not f Like "*~$*" Then
Set wbks = Workbooks.Open(f)
For Each ws In wbks.Worksheets
With ws
.Range("B15:P15" & .Range("C10000").End(xlUp).Row).Copy wbkc.Sheets(3).Range("C100000").End(xlUp).Offset(1, 0)
End With
wbks.Close 0
End Ifmets ton code entre balises </> pour gagner en lisibilité
Cela ne fonctionne pas.
Message d'erreur "End if sans bloc if"
Serait-il possible de voir la totalité du code ou cas il y aurait des erreurs sur le reste du code.
Merci pour tes réponses :-)
Message d'erreur "End if sans bloc if"
Serait-il possible de voir la totalité du code ou cas il y aurait des erreurs sur le reste du code.
ok, ajoute next en effet
If Not f = ThisWorkbook.FullName And Not f Like "*~$*" Then
Set wbks = Workbooks.Open(f)
For Each ws In wbks.Worksheets
With ws
.Range("B15:P15" & .Range("C10000").End(xlUp).Row).Copy wbkc.Sheets(3).Range("C100000").End(xlUp).Offset(1, 0)
End With
Next
wbks.Close 0
End IfSuper cela fonctionne parfaitement la macro consolide bien tous les onglets.
Il ne reste plus qu'à fusionner les 2 macros afin que je puisse créer un nouvel onglet pour chaque consolidation choisie.
Bonsoir,
J'ai bien réussi à faire mes consolidations quand le nom du chemin est dans une cellule fixe (.Range("C5).Value), mais je n'arrive pas a rendre cela dynamique (.Feuil11.Cells(i,10).Value) le chemin utilisé doit dépendre de cette donnée.
<Sub dupliquer_data()
Dim wbks As Workbook, wbkc As Workbook, x As Variant
Dim ws As Worksheet
Dim Cheminfichier As String
Dim f As Object, Fso As Object, adr$
Set Fso = CreateObject("Scripting.FileSystemObject")
Set wbkc = ThisWorkbook
Application.ScreenUpdating = False
Dim ModeCalcul
With Application
ModeCalcul = Application.Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
Dim nom
For i = 4 To 14
If Feuil11.Cells(i, 8) = 1 Then
nom = Feuil11.Cells(i, 6).Value
Application.DisplayAlerts = False
Feuil4.Copy , After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = nom
ActiveSheet.Range("A1").Value = Feuil4.Cells(i, 1)
'For Each f In Fso.GetFolder(Sheets("Consolidate").Range("C5").Value).Files
For Each f In Fso.GetFolder(Sheets("Consolidate V3").Feuil11.Cells(i, 10).Value).Files
If Not f = ThisWorkbook.FullName And Not f Like "*~$*" Then
Set wbks = Workbooks.Open(f)
For Each ws In wbks.Worksheets
With ws
.Range("B15:P15" & .Range("C10000").End(xlUp).Row).Copy wbkc.Sheets(3).Range("C100000").End(xlUp).Offset(1, 0)
End With
Next
wbks.Close 0
End If
Next f
Application.ScreenUpdating = True
MsgBox "Consolidation Terminée", , "Traitement Terminé"
End If
Next i
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub>
Sub dupliquer_data()
Dim wbks As Workbook, wbkc As Workbook, x As Variant
Dim ws As Worksheet
Dim Cheminfichier As String
Dim f As Object, Fso As Object, adr$
Set Fso = CreateObject("Scripting.FileSystemObject")
Set wbkc = ThisWorkbook
Application.ScreenUpdating = False
Dim ModeCalcul
With Application
ModeCalcul = Application.Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
Dim nom
For i = 4 To 14
If Feuil11.Cells(i, 8) = 1 Then
nom = Feuil11.Cells(i, 6).Value
Application.DisplayAlerts = False
Feuil4.Copy , After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = nom
ActiveSheet.Range("A1").Value = Feuil4.Cells(i, 1)
'For Each f In Fso.GetFolder(Sheets("Consolidate").Range("C5").Value).Files
For Each f In Fso.GetFolder(Sheets("Consolidate V3").Feuil11.Cells(i, 10).Value).Files
If Not f = ThisWorkbook.FullName And Not f Like "*~$*" Then
Set wbks = Workbooks.Open(f)
For Each ws In wbks.Worksheets
With ws
.Range("B15:P15" & .Range("C10000").End(xlUp).Row).Copy wbkc.Sheets(3).Range("C100000").End(xlUp).Offset(1, 0)
End With
Next
wbks.Close 0
End If
Next f
Application.ScreenUpdating = True
MsgBox "Consolidation Terminée", , "Traitement Terminé"
End If
Next i
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End SubBonjour,
Merci pour l'explication ;-)
Je reporte donc mon message et mon code entre balises.
J'ai bien réussi à faire mes consolidations quand le nom du chemin est dans une cellule fixe (.Range("C5).Value), mais je n'arrive pas a rendre cela dynamique (.Feuil11.Cells(i,10).Value) le chemin utilisé doit dépendre de cette donnée.
je suis infiniment désolé, mais je n'ai pas le temps de reprendre tout ton code, il reste illisible, il n'est pas indenté.
je ne sais pas si cela fonctionne ... https://forum.excel-pratique.com/excel/smart-indenter-125926#p771655
ou redonne carrément ton fichier et les fichiers à importer