Bonjour,

je me retrouve dans une impasse.
j'ai recupere un code sur un ancient sujet mais je n'arrive pas a l'adapter.
Je m'explique: je souhaite extraire des donnees de plusieurs fichier excel contenu dans un meme repertoire dans un seul fichier.
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
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
113
Sub btnImport()
Dim NbFichiers As Integer
Const Dossier As String = "S:\CREDIT DEPT\merge"
 
 End Sub
 
Private Sub Entete()
    '   Tout effacer
    Cells.Clear
    Range("A3").Formula = "File"
 
    Range("B3").Formula = "Total Assets"
    Range("C3").Formula = "Total FI"
 
 
 
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)
 
 
    NbFichiers = 0
 
    r = Range("A65536").End(xlUp).Row + 1
 
 
    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
 
 
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 = "S:\CREDIT DEPT\merge"
 
 
    Debut = Time()
    Application.ScreenUpdating = False
        Entete
        ListeFichiersDans Dossier
 
        NumeroLigne = 3
        For i = 1 To NbFichiers
            NomFichier = ShImport.Range("A" & NumeroLigne)
 
            Cells(NumeroLigne, 2).valeur = ExtraireValeur(Dossier, NomFichier, NomFeuille, "A10")
            Cells(NumeroLigne, 3).Formula = ExtraireValeur(Dossier, NomFichier, NomFeuille, "C27")
            'Cells(NumeroLigne, 4).Formula = ExtraireValeur(Dossier, NomFichier, NomFeuille, "C9")
 
 
            NumeroLigne = NumeroLigne + 1
            Application.StatusBar = i & " / " & NbFichiers
        Next
 
        Application.StatusBar = "Terminé : " & Format((Time() - Debut) * 100000, "0.00")
 
 
        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
 
 
    Application.ScreenUpdating = True
End Sub
 
 
 
Private Sub Auto_Open()
 
 
    With ActiveWindow
        .ScrollRow = 1
        .ScrollColumn = 1
    End With
    Range("A1").Select
End Sub

Jusqu'a maintenant les seules informations qui s'affichent sont mes en-tete et le nom du fichier dans la premiere colonne mais je n'obtiens pas les valeurs a extraire des fichiers.

PS: desole pour les accents, j'ai un clavier QWERTY

Merci d'avance pour votre aide