Ouvrez tous les fichiers dans les sous-dossiers

Question

Bonjour, j'écris ce code qui me permet d'ouvrir et de copier une feuille dans chaque fichier de macro que j'ai dans de nombreux sous-dossiers. Le problème est que j'ai tous ces fichiers dans les sous-dossiers inclus dans un dossier, mais ils ont tous des noms différents. Que dois-je ajouter à ce code?

Merci beaucoup!

Application.EnableEvents = False 
Application.ScreenUpdating = False 

Path = ActiveWorkbook.Path 

FileName = Dir(Path & "\*.xlsm", vbNormal) 

Do Until FileName = "" 

    Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName, UpdateLinks:=3) 
    For Each ws In Wkb.Worksheets 
    Application.EnableEvents = False 
    Application.ScreenUpdating = False 
    wsName = ws.Name 
    If (wsName = "Summary (Output)") Then 
     ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 
    Exit For 
    End If 
    Next ws 
    Wkb.Close False 
    FileName = Dir() 
Loop 

Je n'ai pas mis toute la déclaration, mais il y a :)

Answer 1

Certaines personnes n'aiment pas cette approche que vous obtenez une petite fenêtre pop-up pour une seconde.

Cela ouvrira tous les .xls classeurs - donc xls, xlsx, xlsm, xlsb et toute autre saveur de xls

Public Sub OpenAllWorkbooks() 

    Dim vFiles As Variant 
    Dim vFile As Variant 

    vFiles = EnumerateFiles("<Folder Path including final backslash - e.g. C:\Windows\>", "xls*") 

    For Each vFile In vFiles 
     Workbooks.Open vFile 
    Next vFile 

End Sub 

Public Function EnumerateFiles(sDirectory As String, _ 
      Optional sFileSpec As String = "*", _ 
      Optional InclSubFolders As Boolean = True) As Variant 

    EnumerateFiles = Filter(Split(CreateObject("WScript.Shell").Exec _ 
     ("CMD /C DIR """ & sDirectory & "*." & sFileSpec & """ " & _ 
     IIf(InclSubFolders, "/S ", "") & "/B /A:-D").StdOut.ReadAll, vbCrLf), ".") 

End Function