Macro copie coller des données d'un classeur à un autre
namy89
Messages postés
6
Statut
Membre
-
namy89 Messages postés 6 Statut Membre -
namy89 Messages postés 6 Statut Membre -
Bonjour,
J'ai besoin de votre aide.
J'ai plusieurs bases, une base par classeur (j'ai en tout une centaine de classeurs) et j'aimerais copier les données issues des ces classeurs dans un seul classeur et former une seule base. Donc regrouper toutes les données dans un seul fichier excel.
Dans tous les classeurs, les onglets contenant les données portent le même nom. Je veux récupérer une seule ligne dans chaque classeur (c'est la même plage de cellule pour chaque classeur), copier et coller dans un nouveau classeur les une après les autres.
Merci de votre aide.
J'ai besoin de votre aide.
J'ai plusieurs bases, une base par classeur (j'ai en tout une centaine de classeurs) et j'aimerais copier les données issues des ces classeurs dans un seul classeur et former une seule base. Donc regrouper toutes les données dans un seul fichier excel.
Dans tous les classeurs, les onglets contenant les données portent le même nom. Je veux récupérer une seule ligne dans chaque classeur (c'est la même plage de cellule pour chaque classeur), copier et coller dans un nouveau classeur les une après les autres.
Merci de votre aide.
2 réponses
-
Bonjour Namy, bonjour le forum,
Le peu d'explications données ne me permet de te proposer qu'un code générique à adapter à ton cas :
Sub Macro1() Dim CC As Workbook 'déclare la variable CC (Classeur Cible) Dim OC As Worksheet 'déclare la variable OC (Onglet Cible) Dim F As String 'déclare la variable F (Fichiers) Dim CS As Workbook 'déclare la variable CS (Classeur Source) Dim OS As Worksheet 'déclare la variable OS (Onglet Source) Dim PL As Range 'déclare la variable PL (PLage) Dim DEST As Range 'déclare la variable DEST (cellule de DESTination) Set CC = ThisWorkbook 'définit le classeur cible CC Set OC = CC.Sheets(1) 'définit l'onglet cible OC (à adapter) F = Dir(CC.Path & "\*.xls?") 'définit le fichier F (premier fichier Excel du dossier contenant ce classeur) Do While F <> "" 'boucle tant qu'il existe des fichiers If Not F = CC.Name Then 'condition : si F n'est pas ce classeur Workbooks.Open (F) 'ouvre le fichier F Set CS = ActiveWorkbook 'définit le classeur source CS Set OS = CC.Sheets(1) 'définit l'onglet source OS (à adapter) Set PL = OS.Range("A1:L1") 'définit la plage PL (à adapter, peut aussi être PL=OS.Rows(1)) 'définit la cellule de destination DEST (A1 si A1 est vide, 'sinon la première cellule vide de la colonne 1 (=A) de l'onglet cible OC (à adapter) Set DEST = IIf(OC.Range("A1").Value = "", OC.Range("A1"), OC.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)) PL.Copy DEST 'copy la plage PL dans DEST CS.Close 'ferme le classeur source End If 'fin de la condition F = Dir 'redéfinit le fichier F (prochain fichier Excel du dossier contenant ce classeur) Loop 'boucle End Sub
Ouvre un classeur vierge, copie ce code dans un module standard, enregistre-le dans le même dossier que celui où se trouvent les autres classeurs (les bases) avec l’extension .xlsm.
Attention ! Le code implique que seules les bases et ce classeurs se trouvent dans le même dossier. Aucun autre fichier Excel ne peut s'y trouver sous peine d'erreur ou de plantage...
-
Bonjour ThauTheme
Merci pour votre aide.
J'ai essayé d'adapter le code mais j'ai un souci avec la déclaration de l'onglet. Lorsque je lance le programme, un message d'erreur s'affiche au niveau de cette déclaration
Set OS = CC.Sheets("LAeq 6h-6h") 'définit l'onglet source OS (à adapter)
J'ai remplacé dans la parenthèse le nom de l'onglet mais il ne reconnait pas.
Pour détailler un peu plus ma problématique :
j'ai en fait une centaine de sujets et chaque sujet a un fichier excel contenant des mesures dans différents onglets.
J'ai envie de regrouper certaines mesures de ces sujets dans un seul classeur donc créer une nouvelle base.
Les mesures se trouvent dans un onglet qui porte le même nom dans chaque classeur et dans la même plage à savoir J2:AP2.
Je veux alors pour chaque sujet donc pour chaque classeur aller dans l'onglet, récupérer cette plage et la copier dans un nouveau classeur , les uns après les autres.
Au final chaque ligne de mon nouveau classeur correspond à la plage de mesure d'un sujet.
Ci dessous le code adapté à ma problématique avec l'erreur que j'ai exposé ci-dessus
Sub Macro1() Dim CC As Workbook 'déclare la variable CC (Classeur Cible) Dim OC As Worksheet 'déclare la variable OC (Onglet Cible) Dim F As String 'déclare la variable F (Fichiers) Dim CS As Workbook 'déclare la variable CS (Classeur Source) Dim OS As Worksheet 'déclare la variable OS (Onglet Source) Dim PL As Range 'déclare la variable PL (PLage) Dim DEST As Range 'déclare la variable DEST (cellule de DESTination) Set CC = ThisWorkbook 'définit le classeur cible CC Set OC = CC.Sheets("Feuil1") 'définit l'onglet cible OC (à adapter) F = Dir(CC.Path & "\*.xls?") 'définit le fichier F (premier fichier Excel du dossier contenant ce classeur) Do While F <> "" 'boucle tant qu'il existe des fichiers If Not F = CC.Name Then 'condition : si F n'est pas ce classeur Workbooks.Open (F) 'ouvre le fichier F Set CS = ActiveWorkbook 'définit le classeur source CS Set OS = CC.Sheets("LAeq 6h-6h") 'définit l'onglet source OS (à adapter) Set PL = OS.Range("J2:AP2") 'définit la plage PL (à adapter, peut aussi être PL=OS.Rows(1)) 'définit la cellule de destination DEST (A1 si A1 est vide, 'sinon la première cellule vide de la colonne 1 (=A) de l'onglet cible OC (à adapter) Set DEST = IIf(OC.Range("A1").Value = "", OC.Range("A1"), OC.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)) PL.Copy DEST 'copy la plage PL dans DEST CS.Close 'ferme le classeur source End If 'fin de la condition F = Dir 'redéfinit le fichier F (prochain fichier Excel du dossier contenant ce classeur) Loop 'boucle End Sub
Merci encore pour votre aide
A+
-
