Consolider plusieurs feuilles de différents classeurs
Bonjour,
dans le cadre de mon stage en entreprise je dois réaliser une consolidation de fichier. Il s'agit ici de copier/coller des informations de plusieurs feuilles de plusieurs classeurs d'un même dossier (qui sont tous identiques, un par personne) afin de les coller (les unes à la suite des autres, sans les écraser) dans un autre classeur définit. Je souhaite réaliser une boucle afin de pouvoir répéter cette macro dans le temps, en ayant la possibilité de modifier le noms des fichiers, des onglets, le lien du dossier où se situe les fichiers a consolider etc...
J'ai commencé à réaliser la macro de récupération, ainsi qu'une autre pour effacer les plages du classeur de consolidation (mais celle-ci fonctionne), mais je sèche sur la recopie. Je vous mets mon code VBA, j'espère avoir été assez clair et détaillé sur ce que je recherche. Si je dois donner plus d'avantage c'est avec plaisir. Je suis novice en VBA, j'ai réussi à en arriver jusque là dans mon code grâce aux forums (anglais et français) mais là je vois pas où est mon erreur.. J'ai une erreur sur la ligne P.Range("A" & Rows.Count).End(xlUp).Offset (1). Erreur 438 : Propriété ou méthode non géré par cet Objet. Je suppose que c'est mon P définit comme Objet qui pose problème, mais j'ai suivis la même procédure qu'avec le F, qui lui fonctionne bien.. Je ne comprends pas ce qui lui pose problème..
Le code :
Sub Consolidation_GCM_Files()
'Fonction de la macro : Automatise la récupération des données
'depuis plusieurs fichiers (d'un même dossier) dans un fichier global
Application.DisplayAlerts = False
Workbooks("Annual Plan Consolidation.xlsm").Activate
' Définit les valeurs
Dim Fso As Object, MonRepertoire As String
Dim wb1 As Object, wb2 As Workbook, chemin As String
Dim F As Object, P As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set wb1 = ThisWorkbook
Set wb2 = Workbooks("Annual Plan Consolidation.xlsm")
Set F = wb1.Sheets(Array(Feuil2.Name, Feuil4.Name, Feuil5.Name, Feuil7.Name, Feuil8.Name, Feuil9.Name, Feuil10.Name, Feuil13.Name))
Set P = wb2.Sheets(Array(Feuil2.Name, Feuil4.Name, Feuil5.Name, Feuil7.Name, Feuil8.Name, Feuil9.Name, Feuil10.Name, Feuil13.Name))
chemin = Feuil1.Range("J6").Value
MonRepertoire = chemin
'Boucle
For Each wb1 In Fso.GetFolder(MonRepertoire).Files
Workbooks.Open wb1
For Each F In F
F.Range("A3:BA10000").Copy
wb2.Activate
P.Range("A" & Rows.Count).End(xlUp).Offset (1)
P.PasteSpecial xlPasteFormats
P.PasteSpecial xlPasteValues
Next
Windows(wb1.Name).Close
Next wb1
'Fin
Application.DisplayAlerts = True
MsgBox "Mise à jour des données effectuée."
End SubMerci pour votre considération.
Cordialement,
ARIGOLD26
bonjour
essaie ceci (non testé)
Sub Consolidation_GCM_Files()
'Fonction de la macro : Automatise la récupération des données
'depuis plusieurs fichiers (d'un même dossier) dans un fichier global
Application.DisplayAlerts = False
Workbooks("Annual Plan Consolidation.xlsm").Activate
' Définit les valeurs
Dim Fso As Object, MonRepertoire As String
Dim wb1 As Object, wb2 As Workbook, chemin As String
Dim LF As Object, F As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set wb2 = Workbooks("Annual Plan Consolidation.xlsm") ' doit être ouvert
chemin = Feuil1.Range("J6").Value
MonRepertoire = chemin
'Boucle
For Each wb1 In Fso.GetFolder(MonRepertoire).Files
Workbooks.Open wb1
Set LF = wb1.Sheets(Array(Feuil2.Name, Feuil4.Name, Feuil5.Name, Feuil7.Name, Feuil8.Name, Feuil9.Name, Feuil10.Name, Feuil13.Name))
For Each F In LF
F.Range("A3:BA10000").Copy
wb2.Activate
sheets(f.name).Range("A" & Rows.Count).End(xlUp).Offset (1).select
selection.PasteSpecial xlPasteFormats
selection.PasteSpecial xlPasteValues
Next
Windows(wb1.Name).Close
Next wb1
'Fin
Application.DisplayAlerts = True
MsgBox "Mise à jour des données effectuée."
End SubSalut,
Essaie de joindre un fichier tant qu'à faire.
Je prends le risque de dire une connerie, mais je pense que le problème vient de ton "offset".
Essaie un truc du genre
F.Range("A3:BA10000").Copy Destination:=P.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Où offset te décale d'une ligne.
Offset prends les mêmes caractéristiques que Cells, il faut lui préciser la ligne et la colonne
Bonjour,
merci pour vos réponses rapides ! Néanmoins vos deux propositions ne fonctionne pas hélas.. j'ai la même erreur. Je vous joint les fichiers pour que ce soit plus facile à appréhender pour vous (le fichier consolidation avec la macro et deux exemples de fichier a consolider). Je pense que c'est une petite modification à apporter. L'idée est là..
Merci pour votre aide à tout les deux,
ARIGOLD26
re-bonjour,
une proposition corrigée et testée.
Sub Consolidation_GCM_Files()
'Fonction de la macro : Automatise la récupération des données
'depuis plusieurs fichiers (d'un même dossier) dans un fichier global
Application.DisplayAlerts = False
Workbooks("Annual Plan Consolidation.xlsm").Activate
' Définit les valeurs
Dim MonRepertoire As String
Dim wb1 As String, wb2 As Workbook, chemin As String
Dim LF As Variant, Fn As Variant, f As Object
Set wb2 = Workbooks("Annual Plan Consolidation.xlsm") ' doit être ouvert
chemin = Feuil1.Range("J6").Value
MonRepertoire = chemin
'Boucle
wb1 = Dir(MonRepertoire & "\*.xlsx")
While wb1 <> ""
Set wb = Workbooks.Open(MonRepertoire & "\" & wb1)
LF = Array(Feuil2.Name, Feuil4.Name, Feuil5.Name, Feuil7.Name, Feuil8.Name, Feuil9.Name, Feuil10.Name, Feuil13.Name)
For Each Fn In LF
Set f = wb.Sheets(Fn)
f.Range("A3:BA10000").Copy
wb2.Activate
Sheets(f.Name).Activate
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial xlPasteFormats
Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Next
Workbooks("Annual Plan Consolidation.xlsm").Activate
wb.Saved = True
wb.Close
wb1 = Dir()
Wend
'Fin
Application.DisplayAlerts = True
MsgBox "Mise à jour des données effectuée."
End SubMerci beaucoup ! ça fonctionne très bien.
ARIGOLD26