Discussion :

[krypsi12]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Thautheme]

Bonsoir Krypsi, bonsoir le forum,

Essaie comme ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[krypsi12]

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

[78chris]

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

[fraflt69]

Bonjour à tous

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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