XL 2016 Importer les données de plusieurs fichiers Excel portant le même nom dans un nouveau fichier

[Dadi147]

Bonjour. Renseignements pour ceux qui ont de l'expérience. J'ai 7 fichiers Excel avec le même nom, (summary).ils ont été placés dans 7 dossiers dans un dossier, et je veux un moyen de les copier dans un nouveau fichier en dessous l'un de l'autre. Pouvons-nous faire cela

 

[Dadi147]

Bonjour. @job75 Parfois j'ai le même fichier mais avec un nom différent, puis-je le modifier dans le code par exemple ?

fichier = Array("test.xls", "data.xls")

 

[job75]

Bonjour Dai147,

Oui un Array plus une boucle supplémentaire.

Prévoir aussi un test pour vérifier que le fichier existe :

Sub Importer()
Dim chemin$, dossier, fichier, F As Worksheet, lig&, i%, j%, x$, h&
chemin = ThisWorkbook.Path & "\"
dossier = Array("Dossier1", "Dossier2", "Dossier3", "Dossier4", "Dossier5", "Dossier6", "Dossier7") 'liste à adapter
fichier = Array("test.xls", "data.xls") 'à adapter
Set F = ActiveSheet
lig = 2 '1ère ligne de destination
Application.ScreenUpdating = False
F.Rows(lig & ":" & F.Rows.Count).Delete 'RAZ
For i = 0 To UBound(dossier)
    For j = 0 To UBound(fichier)
        x = chemin & dossier(i) & "\" & fichier(j)
        If Dir(x) <> "" Then 'si le fichier existe
            With Workbooks.Open(x).Sheets(1) 'ouverture du fichier
                If .FilterMode Then .ShowAllData 'si la feuille est filtrée
                h = .Range("B" & .Rows.Count).End(xlUp).Row 'dernière ligne en colonne B
                .Rows("1:" & h).Copy F.Cells(lig, 1)    'copier-coller
                lig = lig + h + 3 '3 lignes vides
                .Parent.Close False 'fermeture du fichier
            End With
        End If
Next j, i
End Sub

A+