Fusionner des données de 70 fichiers excel en 1 seul

Version imprimable

Bonjour à tous,

Je viens sur ce forum en dernier recours après avoir testé mille et une macro et visualisé plusieurs tuto excel.
J'ai 1 dossier sur le bureau un dossier noté Recap contenant mes 70 fichiers excel. Chaque fichier excel possède la même structure avec 2 lignes remplies et colonnes remplies jusque EP. Mon objectif est de pouvoir fusionner les données de ces 2 lignes de mes 70 fichiers rapidement (je me suis résignée à le faire à la main) dans un 1 seul fichier excel. Voici la dernière macro testée :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Sub recup() Range("A1").Select 'sélectionner la cellule de début Chemin = "c:\Users\Desktop\recap\" '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("A1:EP2").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
Je pense que j'ai un problème sur "Range" => je souhaite copier toujours les 2 premières lignes de A1:EP2 de chaque fichier. J'ai essayé de nommer une plage comme demandé mais cela ne fonctionne pas....

Je vous remercie pour votre aide précieuse !
Merci bcp

Bonsoir Krypsi, bonsoir le forum,

Essaie comme ça :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub recup()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Workbook 'déclare la variable OS (Onglet Source)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim F As String 'déclare la variable F (Fichier)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
 
Application.ScreenUpdating = False 'masque les raffraîchissements d'écran
Set CD = ThisWorkbook 'définit la classeur destination CD
Set OD = CD.Worksheets(1) 'définit l'onglet destination OD (ici j'ai codé comme étant le premier onglet du classeur destination, tu adapteras si ce n'est pas ça)
CA = "c:\Users\Desktop\recap\" 'dédinit le chemin d'accès CA
F = Dir(Chemin & "*.xls") 'définit le premier fichier F d'extension xls ayant CA comme chemin d'accès
Do While Fichier <> "" ' boucle tant que F n'est pas vide
    Set CS = Workbooks.Open(CA & F) 'définit le classeur source CS en l'ouvrant
    Set OS = CS.Worksheets(1) 'définit l'onglet source OS (ici j'ai codé comme étant le premier onglet du classeur source, tu adapteras si ce n'est pas ça)
    'définit la cellule de destination DEST (A1 si A1 de l'onglet OD est vide, sinon la première celllue vide de la colonne A de l'onglet OD)
    If OD.Range("A1").Value = "" Then Set DEST = OD.Range("A1") Else Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0)
    OS.Range("A1:EP2").Copy DEST 'copie la plage A1:EP2 de l'onglet source et la colle dans DEST
    CS.Close False 'ferme le classeur source sans enregistrer
    Fichier = Dir 'définit le prochain dichier F d'extension xls ayant CA comme chemin d'accès
Loop 'boucle
Application.ScreenUpdating = True 'Affiche les raffraîchissements d'écran
End Sub

19/03/2021, 21h25
krypsi12

2 pièce(s) jointe(s)

Bonjour Thautheme,

merci beaucoup pour ton aide, c'est vraiment gentil.
Je viens de récupérer ta macro que j'ai inséré sur VBA mais il semblerait que rien ne se déclenche. Je t'ai mis un exemple avec 2 fichiers / 70 pour te montrer exactement le type de tableau que j'ai.
Est-ce qu'il y a qqch que je dois modifier dans la macro ?

Merci bcp!!
Hélène
19/03/2021, 22h15
78chris

1 pièce(s) jointe(s)

Bonjour à tous

Synthèse par PowerQuery (intégré à Excel 2016 &+, en add on sur 2010 et 2013)

Modifier le chemin d'accès puis Données, Actualiser tout

Le dossier ne doit contenir qu'un même type de fichiers

Bonjour à tous

Reprise du code de Thautheme (Dim OS as WorkSheet, ... F = Dir(CA & "*.xls*") Do While F<>"" .... F=Dir Loop....)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub recup()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As WorkSheet 'déclare la variable OS (Onglet Source)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim F As String 'déclare la variable F (Fichier)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
 
Application.ScreenUpdating = False 'masque les raffraîchissements d'écran
Set CD = ThisWorkbook 'définit la classeur destination CD
Set OD = CD.Worksheets(1) 'définit l'onglet destination OD (ici j'ai codé comme étant le premier onglet du classeur destination, tu adapteras si ce n'est pas ça)
CA = "c:\Users\Desktop\recap\" 'dédinit le chemin d'accès CA
F = Dir(CA & "*.xls*") 'définit le premier fichier F d'extension xls ayant CA comme chemin d'accès
Do While F <> "" ' boucle tant que F n'est pas vide
    Set CS = Workbooks.Open(CA & F) 'définit le classeur source CS en l'ouvrant
    Set OS = CS.Worksheets(1) 'définit l'onglet source OS (ici j'ai codé comme étant le premier onglet du classeur source, tu adapteras si ce n'est pas ça)
    'définit la cellule de destination DEST (A1 si A1 de l'onglet OD est vide, sinon la première celllue vide de la colonne A de l'onglet OD)
    If OD.Range("A1").Value = "" Then Set DEST = OD.Range("A1") Else Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0)
    OS.Range("A1:EP2").Copy DEST 'copie la plage A1:EP2 de l'onglet source et la colle dans DEST
    CS.Close False 'ferme le classeur source sans enregistrer
    F = Dir 'définit le prochain fichier F d'extension xls ayant CA comme chemin d'accès
Loop 'boucle
Application.ScreenUpdating = True 'Affiche les raffraîchissements d'écran
End Sub

20/03/2021, 10h55
krypsi12

bonjour à tous,

merci pour vos solutions mais pour l'instant il y a toujours un truc qui cloche ^^
quand je lance le code dans un nouveau fichier je vois qu'il travaille mais il ne se passe rien dans le fichier de destination. Etrange ?

Concernant query, j'ai déjà essayé mais il m'a mis un message d'erreur sur la ligne 3 avec "la ligne ne correspond à aucune clé" donc j'ai abandonné cette possibilité...

Merci pour votre aide

Bonjour le fil, bonjour le forum,

Merci à Fraflt d'avoir corrigé mon premier code plein d'erreurs !...

@ Hélène
Si le classeur maître, celui qui contient le code, se trouve dans le même dossier Recap j'ai modifié le code.
Si rien ne se passe, c'est je pense, que le chemin d'accès n'est pas bon. Vérifie le à la lettre près car le code que je te propose est sensiblement identique à ton code initial.
Le nouveau code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub recup()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim F As String 'déclare la variable F (Fichier)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
 
Application.ScreenUpdating = False 'masque les raffraîchissements d'écran
Set CD = ThisWorkbook 'définit la classeur destination CD
Set OD = CD.Worksheets(1) 'définit l'onglet destination OD (ici j'ai codé comme étant le premier onglet du classeur destination, tu adapteras si ce n'est pas ça)
CA = "H:\Documents\Poubelle\Krypsi\" 'dédinit le chemin d'accès CA
F = Dir(CA & "*.xls") 'définit le premier fichier F d'extension xls ayant CA comme chemin d'accès
Do While F <> "" ' boucle tant que F n'est pas vide
    If F <> ThisWorkbook.Name Then
        Set CS = Workbooks.Open(CA & F) 'définit le classeur source CS en l'ouvrant
        Set OS = CS.Worksheets(1) 'définit l'onglet source OS (ici j'ai codé comme étant le premier onglet du classeur source, tu adapteras si ce n'est pas ça)
        'définit la cellule de destination DEST (A1 si A1 de l'onglet OD est vide, sinon la première celllue vide de la colonne A de l'onglet OD)
        If OD.Range("A1").Value = "" Then Set DEST = OD.Range("A1") Else Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0)
        OS.Range("A1:EP2").Copy DEST 'copie la plage A1:EP2 de l'onglet source et la colle dans DEST
        CS.Close False 'ferme le classeur source sans enregistrer
    End If
    F = Dir 'définit le prochain dichier F d'extension xls ayant CA comme chemin d'accès
Loop 'boucle
Application.ScreenUpdating = True 'Affiche les raffraîchissements d'écran
End Sub

20/03/2021, 16h09
78chris

Bonjour à tous

Citation:

Envoyé par krypsi12

Concernant query, j'ai déjà essayé mais il m'a mis un message d'erreur sur la ligne 3 avec "la ligne ne correspond à aucune clé" donc j'ai abandonné cette possibilité...

De quelle ligne 3 tu parles ?

Il n'y a pas de numérotation de lignes...

Tu dis que tu as déjà essayé : donc on ne sait si tu parles de tes propres essais ou du fichier que j'ai posté, qui, lui, fonctionne bien sur les 2 fichiers que tu as fournis... et devrait donc fonctionner sur les 70 si pas d'autres fichiers dans le dossier et si structure homogène...