Récupérer des données de plusieurs Excel

**Bobooot** · 24/01/2017, 11h10

Bonjour à tous,

Etant complètement novice en VBA, je suis complètement bloqué sur une macro.
J'ai réalisé un questionnaire de satisfaction destiné aux employés d'agences de voyage.

Devant le nombre énorme de retours, il est impossible de récupérer les infos de chaque questionnaire un par un.
J'ai donc créé un fichier bilan afin de compiler les résultats de tous les questionnaires se trouvant dans un dossier définis.

Le problème est que dans mon code actuel, je dois préciser le fichier à ouvrir. Je souhaiterais que la macro ouvre tous les fichiers présents dans un répertoire défini puis copie les cellules (toujours les mêmes) et les colles côte à côte dans le fichier Bilan sur la feuille "Données"

Voici mon code :

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
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Sub CreationSynthese()
'Création des titres
Range("A8") = "Confort acoustique"
Range("A9") = "Confort visuel"
Range("A10") = "Confort olfactif"
Range("A11") = "Confort hygrométrique"
Range("A12") = "Confort thermique"
Range("A13") = "Gestion des déchets"
Range("A14") = "Gestion de l'eau"
Range("A15") = "Accès à l'agence"
Range("A16") = "Sociétal"
 
'Ouverture du fichier "Questionnaire 1"
Workbooks.Open "...\Questionnaire 1.xlsm" 'chemin vers le fichier
 
'Copier cellules de "Questionnaire 1" vers "Bilan agence"
Workbooks("Bilan agence.xlsm").Sheets(2).Range("B8") = Workbooks("Questionnaire 1.xlsm").Sheets("Résultats").Range("M21")
Workbooks("Bilan agence.xlsm").Sheets(2).Range("B9") = Workbooks("Questionnaire 1.xlsm").Sheets("Résultats").Range("M22")
Workbooks("Bilan agence.xlsm").Sheets(2).Range("B10") = Workbooks("Questionnaire 1.xlsm").Sheets("Résultats").Range("M23")
Workbooks("Bilan agence.xlsm").Sheets(2).Range("B11") = Workbooks("Questionnaire 1.xlsm").Sheets("Résultats").Range("M24")
Workbooks("Bilan agence.xlsm").Sheets(2).Range("B12") = Workbooks("Questionnaire 1.xlsm").Sheets("Résultats").Range("M25")
Workbooks("Bilan agence.xlsm").Sheets(2).Range("B13") = Workbooks("Questionnaire 1.xlsm").Sheets("Résultats").Range("M26")
Workbooks("Bilan agence.xlsm").Sheets(2).Range("B14") = Workbooks("Questionnaire 1.xlsm").Sheets("Résultats").Range("M27")
Workbooks("Bilan agence.xlsm").Sheets(2).Range("B15") = Workbooks("Questionnaire 1.xlsm").Sheets("Résultats").Range("M28")
Workbooks("Bilan agence.xlsm").Sheets(2).Range("B16") = Workbooks("Questionnaire 1.xlsm").Sheets("Résultats").Range("M29")
 
'Fermeture du fichier "Questionnaire 1"
Workbooks("Questionnaire 1.xlsm").Close
 
'Ouverture du fichier "Questionnaire 1"
Workbooks.Open "\Questionnaire 2.xlsm" 'chemin vers le seconf fichier
 
'Copier cellules de "Questionnaire 2" vers "Bilan agence"
Workbooks("Bilan agence.xlsm").Sheets(2).Range("C8") = Workbooks("Questionnaire 2.xlsm").Sheets("Résultats").Range("M21")
Workbooks("Bilan agence.xlsm").Sheets(2).Range("C9") = Workbooks("Questionnaire 2.xlsm").Sheets("Résultats").Range("M22")
Workbooks("Bilan agence.xlsm").Sheets(2).Range("C10") = Workbooks("Questionnaire 2.xlsm").Sheets("Résultats").Range("M23")
Workbooks("Bilan agence.xlsm").Sheets(2).Range("C11") = Workbooks("Questionnaire 2.xlsm").Sheets("Résultats").Range("M24")
Workbooks("Bilan agence.xlsm").Sheets(2).Range("C12") = Workbooks("Questionnaire 2.xlsm").Sheets("Résultats").Range("M25")
Workbooks("Bilan agence.xlsm").Sheets(2).Range("C13") = Workbooks("Questionnaire 2.xlsm").Sheets("Résultats").Range("M26")
Workbooks("Bilan agence.xlsm").Sheets(2).Range("C14") = Workbooks("Questionnaire 2.xlsm").Sheets("Résultats").Range("M27")
Workbooks("Bilan agence.xlsm").Sheets(2).Range("C15") = Workbooks("Questionnaire 2.xlsm").Sheets("Résultats").Range("M28")
Workbooks("Bilan agence.xlsm").Sheets(2).Range("C16") = Workbooks("Questionnaire 2.xlsm").Sheets("Résultats").Range("M29")
 
'Fermeture du fichier "Questionnaire 1"
Workbooks("Questionnaire 2.xlsm").Close
 
End Sub