Discussion :

[sofy2]

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

[pasdechances]

Bonjour,

ton problème viens de la :

Code :

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

1
2
3
            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")

Ces trois ligne permettent de remplir une cellule avec une formule de 'lien' il faut donc que tu paramètre correctement la fonction "ExtraireValeur".

le copier coller c'est mal, et encore plus quand on le comprend pas.

cela dit, même si c'est en reprenant des morceaux de code que beaucoup on appris, mieux vos copier des morceaux de code qui ne marche pas et qu'on est susceptible de comprendre pour l'assimiler, le modifier et donc nous améliorer, plutôt que de prendre un truc qui marche et qu'on peut pas modifier parce qu’on ne le comprend pas.
Attention, je ne te critique pas, c'est juste un conseil, je suis déjà passer par la et je sais au combien il est glissant le code du voisin.

[sofy2]

Merci pour votre reponse.

j'ai en effet recuperer le code et tenter de le comprendre. j'ai aussi pu me render compte que la partie que vous avez surligne est celle qui pose problem mais je n'arrive pas a la modifier.
pouvez vous m'aider?