Synthèse plusieurs tableau de différents fichiers dans un fichier synthese
P
Bonjour,
Je dois compiler plusieurs tableaux dans des fichiers distincts (6 dans ce cas) dans un seul fichier (et idéalement à la suite) pour effectuer des tris et une synthèse sur l'ensemble des données (en l'occurrence ici du personnel et le nombre d'heures travaillées par jour). L'avantage c'est que mes tableaux ont les mêmes structures, mais pas le même nombre de lignes.
J'ai essayé le copier-coller spécial ou de compiler les données mais ce n'est pas très efficace.
J'ai tenté la macro suivante mais rien ne se passe dans mon fichier test.
Sub recup()
Range("A1").Select 'sélectionner la cellule de début
Chemin = "Z:\COMMUN\9.MATERIAUX\9.8 POINTAGE\2021\01-janvier\" 'saisir le chemin complet du dossier où se trouvent les fichiers
Fichier = Dir(Chemin & "*.xls") ' Premier fichier
Do While Fichier <> ""
Workbooks.Open Filename:=Chemin & Fichier
Range("Zone_copiee").Copy
ThisWorkbook.Activate
ActiveSheet.Paste
Windows(Fichier).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
Fichier = Dir ' Fichier suivant
Loop
End Sub
Les différents fichiers sont de la forme suivante (voir PJ) et je ne voudrais copier dans chaque fichier que la feuille contenant le personnel vers mon fichier test.
Auriez-vous une autre macro ou alors une solution pour ma macro ici présente ?
Merci d'avance à vous tous !!
Je dois compiler plusieurs tableaux dans des fichiers distincts (6 dans ce cas) dans un seul fichier (et idéalement à la suite) pour effectuer des tris et une synthèse sur l'ensemble des données (en l'occurrence ici du personnel et le nombre d'heures travaillées par jour). L'avantage c'est que mes tableaux ont les mêmes structures, mais pas le même nombre de lignes.
J'ai essayé le copier-coller spécial ou de compiler les données mais ce n'est pas très efficace.
J'ai tenté la macro suivante mais rien ne se passe dans mon fichier test.
Sub recup()
Range("A1").Select 'sélectionner la cellule de début
Chemin = "Z:\COMMUN\9.MATERIAUX\9.8 POINTAGE\2021\01-janvier\" 'saisir le chemin complet du dossier où se trouvent les fichiers
Fichier = Dir(Chemin & "*.xls") ' Premier fichier
Do While Fichier <> ""
Workbooks.Open Filename:=Chemin & Fichier
Range("Zone_copiee").Copy
ThisWorkbook.Activate
ActiveSheet.Paste
Windows(Fichier).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
Fichier = Dir ' Fichier suivant
Loop
End Sub
Les différents fichiers sont de la forme suivante (voir PJ) et je ne voudrais copier dans chaque fichier que la feuille contenant le personnel vers mon fichier test.
Auriez-vous une autre macro ou alors une solution pour ma macro ici présente ?
Merci d'avance à vous tous !!
Bonjour,
Le problème c'est que ton :
Range("Zone_copiee").Copy... ne se prête pas bien à ce genre de sport : Tu t'es fatigué à définir une zone à copier alors que tu en avais une toute cuite qui te tendait les bras...
Remplace cette ligne avec :
[T_Saisie_Personnel_1].CopyEuh... Non test2 bien sur à cause des problèmes de chemin, mais si le problème de chemin/fichier est bien résolu, la copie devrait passer.
Après bien sur tu auras quelques lignes de plus à filtrer, mébon...
a=
3
Bonjour,
Voici un essai d'adaptation du code.
On copie à chaque fois la plage "Zone_copiee" (de la feuille active, faute d'infos) de chaque fichier vers le fichier exécutant, à la suite des copies précédentes sur la feuille de destination (à adapter !!!) :
Sub recup()
Chemin = "Z:\COMMUN\9.MATERIAUX\9.8 POINTAGE\2021\01-janvier\" 'saisir le chemin complet du dossier où se trouvent les fichiers
set wsdest = thisworkbook.sheets("destination") '<<< ADAPTER LE NOM DE LA FEUILLE DE DESTINATION !!!
Fichier = Dir(Chemin & "*.xls") ' Premier fichier
Do While Fichier <> ""
set wb = Workbooks.Open(Filename:=Chemin & Fichier)
nvl = wsdest.cells(wsdest.rows.count, 1).end(xlup).row + 1
with wb
.activesheet.Range("Zone_copiee").Copy wsdest.range("A" & nvl)
.Close savechanges:=False
end with
Fichier = Dir ' Fichier suivant
Loop
End SubIl faut modifier le nom de la feuille qui accueille les données.
Cdlt,