Récupérer les mêmes données sur plusieurs classeurs

**Nicko29** · 13/04/2012, 22h19

Bonsoir,

Je voulais m'inspirer du code de cette discussion pour extraire les données de plusieurs cellule de plusieurs classeur excel, afin de faire une synthèse.
J'ai un répertoire ou est mon fichier de récuperation, dans ce répertoire j'ai une grande quantité de sous répertoire (un niveau seulement) qui contiennent des classeur excel et d'autres fichiers.

Mon but est d'obtenir un tableau avec par ligne toutes les cellules copiées d'un classeur afin d'avoir une synthèse.

Hors en utilisant le code suivant

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 test1()
    Dim Chemin As String, Fichier As String, Ligne As Long
    Dim Feuilles, Sh As Worksheet, Tabl
    Chemin = "F:\Weiss\Excel\Fiches retour chantier DOLE\017-AVOF-DOL"
    Fichier = Dir(Chemin & "*.xls")
    Set Sh = Sheets.Add
    Do While Fichier <> ""
        ThisWorkbook.Names.Add "Plage", _
            RefersTo:="='" & Chemin & "[" & Fichier & "]DonnesU'!$A$1:$Z$100"
        With Sh
            .[A1:Z100] = "=Plage"
            .[A1:Z100].Copy
            .[A1:Z100].PasteSpecial xlPasteValues
            ' Tabl est un tableaureprésentant la zone A1:Z100 du classeur fermé en cours de traitement
            ' la première dimension représente le numéro de ligne
            ' et la seconde le numéro de colonne
            Tabl = .[A1:Z100]
            Cells.ClearContents
            Ligne = Ligne + 1
            Cells(Ligne, 1) = Tabl(17, 1) ' renseigne A1
            'etc.
        End With
        Fichier = Dir
    Loop
End Sub

Il m'ajoute des feuilles supplémentaire en fonction du nombre de fichier excel qu'il trouve,mais rien d'autre. Je ne comprend pas.
Pouvez-vous m'éclairer ?

Merci

**Daniel.C** · 14/04/2012, 13h19

Bonjour,

Bizarre que tu aies pu faire tourner cette macro. La ligne suivante est incorrecte :

Code :

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

Fichier = Dir(Chemin & "*.xls")

Tu aurais dû mettre :

Code :

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

Fichier = Dir(Chemin & "\*.xls")

Ensuite, tu copies la plage A1:Z100 de la feuille DonnesU du fichier traité et tu la colles au même endroit sur la feuille ajoutée. Tu effaces la feuille :

Code :

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

Cells.ClearContents

et tu remplis la cellule A1 :

Code :

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

Cells(Ligne, 1) = Tabl(17, 1)

Lorsque tu traites le classeur suivant, tu effaces ce que tu viens d'écrire. Cette écriture devrait se faire sur une autre feuille. Par exemple :

Code :

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

sheets("Feuil2").Cells(Ligne, 1) = Tabl(17, 1)

Maintenant, pourquoi utiliser la plage A1;Z100 si tu traites seulement une cellule (A17] ?
Essaie plutôt comme ceci. La macro à exécuter est Test1 :
En tête du module :

Code :

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

Public Ligne As Long

puis :

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
Sub test1()
    Dim FSO As Object, Doss As Object, F As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    'Chemin = "F:\Weiss\Excel\Fiches retour chantier DOLE\017-AVOF-DOL"
    Set sh = Sheets.Add
    Chemin = "C:\Users\Daniel\Documents\Donnees\Daniel\mpfe"
    Test2 Chemin
    For Each Doss In FSO.getfolder(Chemin).SubFolders
        Test2 Doss.Path
    Next
End Sub
 
 
Sub Test2(Chemin)
    Dim txt As String, Fich As String
    Dim FSO As Object, Feuille As String, sh As Worksheet
    Feuille = "Feuil1"
    With sh
        Fich = Dir(Chemin & "\*.xls")
        Do While Fich <> ""
            'Feuille="DonnesU"
            Ligne = Ligne + 1
            txt = "'" & Chemin & "\[" & Fich & "]" & Feuille & "'!R17C1"
            Cells(Ligne, 1) = ExecuteExcel4Macro(txt)
            Fich = Dir
        Loop
    End With
End Sub