macro Excel Ouvrir les dossiers ds un repertoire et acceder au fichier y contenuFermé

Question

Bonjour à tous,
j'ai dans un repertoire 8 dossiers.
Chaque dossier contient des fichiers excel.
Je voudrais créer une boucle qui devrait .
- ouvrir le premier dossier, puis ouvrir, copier et compiler dans un nouveau classeur excel les données de chaque fichier excel contenu ds ce premier dossier
- passer au second dossier et executer les memes actions et ainsi de suite.

Pour l'instant je suis capable de creer une boucle qui copie et compile uniquement des fichiers excel contenues dans un seul dossier. Je voudrais à cet effet un code qui me permette d'executer les memes actions sur les autres dossiers contenues dans ce repertoire.

Voila le code qui me permet de compiler les données du dossier1
Option Explicit
'Déclaration des Variables
Dim Chemin As String, Fichier As String
Dim LigneTotal As Long
Dim Derligne As Long


Sub macro_compil()
'
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Worksheets("compils").Visible = True
    Worksheets("compils").Select
    Rows("1:1000000").Select
    Selection.Clear
    Range("A1").Select
    Range("A1").Value = "Department"
    Range("B1").Value = "Date_"
    Range("C1").Value = "Numéro_"
    Range("D1").Value = "Code_"
    Range("E1").Value = "Nom_"
    Range("F1").Value = "Classe"
    Range("G1").Value = "Montant"
    Range("H1").Value = "Type_Paiement"
    Range("I1").Value = "Region"
    Range("J1").Value = "Department"
    Range("K1").Value = "Arrondissement"
    Range("L1").Value = "NOM ETABLISSEMENT"
    Range("M1").Value = "Type"
    Range("N1").Value = "Motif"
    
    
    ChDir "C:\Users\JANNOT\Desktop\DONNEES ADAMAOUA\Dossier1"
    Chemin = Dir("C:\Users\JANNOT\Desktop\DONNEES ADAMAOUA\Dossier1\*.xls")
    
    
    While Len(Chemin) > 0
        Workbooks.Open "C:\Users\JANNOT\Desktop\DONNEES ADAMAOUA\Dossier1\" & Chemin
        LigneTotal = ActiveSheet.UsedRange.Rows.Count
        Range("A2:N" & LigneTotal).Copy
        Workbooks("Macro_compil_minesec.xlsm").Activate
        Derligne = Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row + 1
        Range("A" & Derligne).Select
        ActiveSheet.Paste
        Workbooks(Chemin).Close
        Chemin = Dir
    Wend
    
    Worksheets("Compils").Activate
    Worksheets("Compils").Select
    Range("A1:N1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\JANNOT\Desktop\DONNEES ADAMAOUA\Compils donnees ADAMAOUA.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWindow.Close
    Worksheets("Compils").Select
    Rows("1:1000000").Select
    Selection.ClearContents
    Range("A1").Select
    Worksheets("Compils").Visible = False
    
End Sub

Merci d'avance.

cs_Le Pivert · Answer

Bonjour,

voir ceci pour parcourir un dossier ainsi que ses sous-dossiers:

 https://grenier.self-access.com/access/fichiers/lister-les-fichiers-dun-dossier-ses-dossiers/

michel_m · Answer

Bonjour 'ton code ne comporte pas de commentaires et il est ainsi ardu de s'y retrouver pour comprendre et aider pour lister tes sous dossiers tu as intér^t à créer une sous macro pour chaque sous dossier Option Explicit'-------------------------------------------------------------------'d'après code de Fred SigonneauSub TousLesDossiers(LeDossier)Dim fso As Object, Dossier As ObjectDim sousRep As Object, Flder As Object, Liste As String Set fso = CreateObject("Scripting.FileSystemObject") Set Dossier = fso.GetFolder(LeDossier) 'examen du dossier courant For Each Flder In Dossier.subfolders chemin = Flder.Path 'lancer une sous macro qui reprend l'examen de chaque sous dossier Call transferer(chemin) Next Set fso = Nothing End Sub '-------------------------------------------------------------------------Sub test() TousLesDossiers "C:\Users\JANNOT\Desktop\DONNEES ADAMAOUA"End Sub D'autre part dans ce genre de cas, il existe une technique qui évite d'ouvrir les fichiers pour la rapidité et le confort visuel avec la technologie ADO mais guère de temps aujourd'hui pour t'aider et pour comprendre ton code

Macro Excel Ouvrir les dossiers ds un repertoire et acceder au fichier y contenu

2 réponses

Discussions similaires

Newsletters