Adapter un bout de code a une extraction

hello all,

Je galère un max pour adapter un bout de code récupérer sur ce forum, à mon problème et j'aurais bien besoin de vos lumières:

Je dois récupérer 3 valeurs dans 700 fichiers excel et les noter dans un tableur.

Détails:
Je dois récupérer les valeurs des cellules A1 A2 A3 & les répercuter dans un fichier LISTE.XLS sur les cases A1 B1 C1.

Tous mes fichiers .xls seront dans le même dossier et le code à adapter est ci dessous. Je ne trouve pas la partie qui permet d'identifier les cellule que l on souhaite exporter.

Si l un d entre vous pouvait m éclairer sur le sujet je lui serait fort reconnaissant.

Je précise que je connais pas VB du tout.

Merci d avance

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
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
Sub btnImport()
Dim NbFichiers As Integer
'   Dossier des classeurs à traiter
Const Dossier As String = "D:\fiches"
 'à modifier pour pointer sur le dossier désiré'
 End Sub
 
Private Sub Entete()
    '   Tout effacer
    Cells.Clear
    Range("C6").Formula = "Fichier"
    ' A tout hasard cela peut être interessant
    ' d'avoir ces infos sur les fichiers
    Range("A1").Formula = "Nom agence"
    Range("A2").Formula = "Nbre de Poste"
    Range("A3").Formula = "Nbre de User"
End Sub
 
Private Sub ListeFichiersDans(NomDossierSource As String)
Dim FSO As Scripting.FileSystemObject
Dim DossierSource As Scripting.Folder
Dim fichier As Scripting.File
Dim r As Long
 
    Set FSO = New Scripting.FileSystemObject
    Set DossierSource = FSO.GetFolder(NomDossierSource)
 
    '   Mettre le compteur à 0
    NbFichiers = 0
    '   Récupérer en haut la 1ere ligne vierge
    r = Range("A65536").End(xlUp).Row + 1
 
    ' Balayer le dossier et extraire le nom des fichiers
    For Each fichier In DossierSource.Files
        Cells(r, 1).Formula = fichier.Name
        Cells(r, 2).Formula = fichier.DateCreated
        Cells(r, 3).Formula = fichier.DateLastModified
        NbFichiers = NbFichiers + 1
        r = r + 1
    Next fichier
 
    Set fichier = Nothing
    Set DossierSource = Nothing
    Set FSO = Nothing
End Sub
 
'   Permet de lire une valeur dans un fichier Excel fermé
Private Function ExtraireValeur(Dossier, fichier, feuille, Cellule)
Dim argument As String
    argument = "'" & Dossier & "[" & fichier & "]" & feuille & "'!" & Range(Cellule).Address(, , xlR1C1)
    ExtraireValeur = ExecuteExcelMacro(argument)
End Function
 
Sub btnImport_QuandClic()
Dim Debut As Variant
Dim NumeroLigne As Integer, i As Integer
Dim NomFichier As String
Dim NomFeuille As String
Const Dossier As String = "D:\fiches"
 
    ' Par curiosité
    Debut = Time()
    Application.ScreenUpdating = False
        Entete
        ListeFichiersDans Dossier
 
        ' Si un onglet de NomFichier ne s'appelle pas NomFeuille
        ' une erreur #REF! est incrite dans les cellules concernées
 
        ' On démarre à cette ligne
        NumeroLigne = 4
        For i = 1 To NbFichiers
            NomFichier = ShImport.Range("A" & NumeroLigne)
 
            Cells(NumeroLigne, 4).Formula = ExtraireValeur(Dossier, NomFichier, NomFeuille, "C7")
            Cells(NumeroLigne, 5).Formula = ExtraireValeur(Dossier, NomFichier, NomFeuille, "C8")
            Cells(NumeroLigne, 6).Formula = ExtraireValeur(Dossier, NomFichier, NomFeuille, "C9")
 
             NumeroLigne = NumeroLigne + 1
            Application.StatusBar = i & " / " & NbFichiers
        Next
 
        Application.StatusBar = "Terminé : " & Format((Time() - Debut) * 100000, "0.00")
 
        ' Revenir en haut à gauche
        With ActiveWindow
            .ScrollRow = 1
            .ScrollColumn = 1
        End With
 
        Rows("3:3").Font.Bold = True
        Columns("B:D").Select
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
        End With
        Columns("A:I").Columns.AutoFit
        Range("A1").Select
 
    '   Rafraichier l'écran à la fin du traitement
    Application.ScreenUpdating = True
End Sub
 
Private Sub Auto_Open()
    ' S'exécutera automatiquement à l'ouverture du fichier
 
    With ActiveWindow
        .ScrollRow = 1
        .ScrollColumn = 1
    End With
    Range("A1").Select
End Sub

'Pour Scripting Runtime http://www.microsoft.com/downloads [...] laylang=en

'Sinon sans scripting Runtime'
'Remplacer ListeFichiersDans par celle ci : plus d'infos sur les dates de création et modif des fichiers.'