Appliquer une macro à tous fichiers d'un répertoire

bonjour à tous

Voici mon problème,j'ai un répertoire: C:\Users\moi\Desktop\produits_TEMPORAIRES\Essai dans lequel j'ai quelques milliers de fichiers qui sont comme le document type "en pièce jointe".

Bien entendu ils sont tous renseignés de manière différente et porte tous un nom différent.

Dans ce répertoire je souhaiterais que tous mes fichiers (qui sont des fichiers excel .xlsx) me remplace le texte d'une cellule par un autre texte.

je vous synthétise ma démarche:

1- Ouvrir le répertoire C:\Users\moi\Desktop\produits_TEMPORAIRES\Essai si il n'est pas déja ouvert.

2- Ouvrir le premier fichier Excel.

3- Chercher dans la colonne D la valeur "Jacques"

4- Une fois la valeur "Jacques" trouvée, remplacer la valeur de la même ligne mais en colonne H, ici "40 ans" par la valeur "45ans"

5- enregistrer le fichier

6- Fermer le fichier

7- Ouvrir le fichier suivant

8- Répéter les étapes 3- à 7- jusqu'à que tout les fichier du répertoire soit modifiés.

9- M'ouvrir une boite de dialogue lorsque toutes les modifications ont été effectuées avec le message "Modifications effectuées"

Je viens pour la première fois de toucher à du VBA il y a 3 jours et j'ai beau chercher sur les forums les formules que j'applique ne semple pas fonctionner. ( sans nul d'autre de ma faute)

Pour les étapes 3 et 4 j'ai une macro plutôt simple qui semble fonctionner:

Columns("D:D").Select

Selection.Find(What:="Jacques", After:=ActiveCell, LookIn:= _

xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _

xlNext, MatchCase:=False, SearchFormat:=False).Activate

ActiveCell.Offset(0, 4).Select

ActiveCell.Replace What:="40 ans", Replacement:="45 ans", _

LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _

False, ReplaceFormat:=False

Pour la suite en revanche je sèche. j'ai vraiment un problème pour créer le reste de ma macro afin qu'elle ouvre un à un mes fichiers Excel pour y appliquer automatiquement mon bout de macro.

72test-masque.zip (9.99 Ko)

Bonjour,

Il faut que tu trouves une chaîne de caractères commune à tous les fichier, et utiliser le code suivant qui permet de boucler sur l'ensemble des fichiers dans un dossier.

Il faut remplacer le "test" par ta chaîne de caractères. Les deux étoiles signifient qu'il peut avoir du texte avant ou après "test"..

Sub LoopThroughFiles()
    Dim StrFile As String
    StrFile = Dir("C:\Users\moi\Desktop\produits_TEMPORAIRES\Essai\*test*")
    Do While Len(StrFile) > 0
        'Ton code ici
       Debug.Print StrFile
        StrFile = Dir
    Loop
End Sub

Cordialement,

Khalid

en l’occurrence et si j'ai bien compris à la place de "test" je mets "*.xlsx" qui est mon seul lien commun entre tous ces fichiers.

La ou tu a mis "ton code ici" c'est la que je peux insérer mon bout de macro?

Oui.

Voici une nouvelle version du code.

Sub LoopThroughFiles()

    Dim StrFile, chemin As String
    chemin = "C:\Users\Khalid\Downloads\"
    StrFile = Dir(chemin & "*.xlsx*")

    Application.ScreenUpdating = False

    Do While Len(StrFile) > 0

        With Workbooks.Open(chemin & StrFile)

        'Ton code ici

        ActiveWorkbook.Close savechanges = True 'Fermer et enregistrer les modifications
        End With

    StrFile = Dir
    Loop
End Sub

Bonjour,

Ce serait sympa si tu me tiens au courant de la solution que j'ai proposé. Merci

Khalid

Oui pardon toutefois j'ai du modifier la commande de sauvegarde du dossier:

Sub LoopThroughFiles()

    Dim StrFile, chemin As String
    chemin = "C:\Users\Khalid\Downloads\"
    StrFile = Dir(chemin & "*.xlsx*")

    Application.ScreenUpdating = False

    Do While Len(StrFile) > 0

        With Workbooks.Open(chemin & StrFile)

        'Ton code ici

        ActiveWorkbook.Save    'enregistrer les modifications
        ActiveWorkbook.Close  'Fermer 
       End With

    StrFile = Dir
    Loop
End Sub

Sinon cela ne sauvegardais pas mon document

Rechercher des sujets similaires à "appliquer macro tous fichiers repertoire"