Effectuer macro sur fichiers d'un répertoire

Bonjour,

J'aurais besoin de votre aide ! J'ai tout essayé et je n'arrive pas à trouver l'erreur

Mon objectif : Parcourir TOUS les fichiers d'un répertoire et y appliquer une macro (Macro recherche et remplace qui n'est pas compliquée) pour ensuite SAUVEGARDER ces modifications soit sur le même fichier ou soit dans un autre fichier.

Voici le code que j'ai trouvé qui me permet de boucler sur l'ensemble des fichiers du répertoire :

Mon code est le suivant :

Sub BoucleFichiers()

Dim Chemin As String, Fichier As String

'Définit le répertoire contenant les fichiers

Chemin = "C:\Users\U329092\Music\Test\"

'Boucle sur tous les fichiers xls du répertoire.

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

'Utilisez la syntaxe suivante pour boucler sur tous les types de fichiers:

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

Do While Len(Fichier) > 0

'écrit le résultat dans la fenêtre d'exécution (Ctrl+G).

Fichier.Open

Call traduction

Debug.Print Chemin & Fichier

Chemin2 = "C:\Users\U329092\Music\Test1\" 'Ouverture d'un autre répertoire existant'

unFichier = "NomClasseur_" & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss") & ".xls"

ActiveWorkbook.SaveCopyAs Chemin2 & unFichier 'Sauvegarde du fichier crée dans ce répertoire existant'

Fichier = Dir()

Loop

End Sub

Ma problématique : "traduction" étant ma macro, celle-ci ne s'effectue que sur le fichier sur lequel je lance ma macro !! Exemple : J'ai 5 fichiers dans un répertoire, ce code parcours bien les 5 fichiers et sauvegarde 5 fichiers dans un répertoire différent. Cependant, ces 5 fichiers restent IDENTIQUES et ne correspondent pas aux fichiers originaux "traduits" (Mon but final étant de traduire automatiquement des fichiers). Je ne parviens pas à EFFECTUER ma macro sur les fichiers mais seulement sur celui dont je lance ma macro.

Je me doute que mon erreur se trouve sur la boucle "For each" mais je ne vois pas comment m'en sortir !!

Merci d'avance pour votre préciseuse aide

Jordan

Bonjour Jordan,

voici un exemple à tester,

la variable wk est déclaré dans le haut du module, ce qui permet de l'utiliser dans la macro traduction

Dim wk As Workbook

Sub Liste_des_fichiers2()
Dim Chemin As String, Fichier As String

Chemin = "C:\Users\U329092\Music\Test\"
Fichier = Dir(Chemin & "*.xls*")

Do While Len(Fichier) > 0
    Workbooks.Open Filename:=Chemin & Fichier
    Set wk = ActiveWorkbook

    Call traduction

    Chemin2 = "C:\Users\U329092\Music\Test1\" 'Ouverture d'un autre répertoire existant'
    unFichier = "NomClasseur_" & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss") & ".xls"
    wk.SaveCopyAs Chemin2 & unFichier 'Sauvegarde du fichier crée dans ce répertoire existant'
'    Fermer le fichier original sans l'enregistrer, n'entraîne pas l'exécution d'une macro AutoClose dans le classeur
    wk.Close SaveChanges:=False
    'prochain fichier
    Fichier = Dir()
Loop
End Sub

Sub traduction()
MsgBox wk.Name
End Sub

Bonjour,

Ou alors, dans le même esprit que sabV que je salut au passage , demander le classeur en argument dans la Sub "Traduction" :

Sub BoucleFichiers()

    Dim Cls As Workbook
    Dim Chemin As String
    Dim Chemin2  As String
    Dim Fichier As String
    Dim unFichier As String

    'Définit le répertoire contenant les fichiers
    Chemin = "C:\Users\U329092\Music\Test\"

    'Boucle sur tous les fichiers xls du répertoire.
    Fichier = Dir(Chemin & "*.xls")
    'Utilisez la syntaxe suivante pour boucler sur tous les types de fichiers:
    'Fichier = Dir(Chemin & "*.*")

    Do While Len(Fichier) > 0

        'écrit le résultat dans la fenêtre d'exécution (Ctrl+G).
        Set Cls = Workbooks.Open(Chemin & Fichier)

        Traduction Cls

        Debug.Print Chemin & Fichier

        Chemin2 = "C:\Users\U329092\Music\Test1\" 'Ouverture d'un autre répertoire existant'
        unFichier = "NomClasseur_" & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss") & ".xls"

        Cls.SaveCopyAs Chemin2 & unFichier 'Sauvegarde du fichier crée dans ce répertoire existant'

        Cls.Close False

        Fichier = Dir()

    Loop

End Sub

Sub Traduction(Classeur As Workbook)

    MsgBox Classeur.Name

End Sub

Bonjour,

Ca marche nickel !!!

Merci beaucoup de votre aide !!!!

Merci pour ce retour, au plaisir!

si le problème est résolu, s.v.p. pour clôturer le fil, cliquer sur le bouton V vert du post à coté du bouton EDITER, merci!

Rechercher des sujets similaires à "effectuer macro fichiers repertoire"