Executer une macro sur plusieurs classeurs

[nonoTT]

Bonjour
Je cherche à exécuter la même macro sur plusieurs fichiers.
Ce que je veux c'est :
- A partir d'un répertoire où se trouvent les fichiers .csv dans l'exemple (C:\Users\AAIGOUI\Desktop\EEQ VO)
- Exécuter la macro VO_Synthese_EEQ pour chaque fichier csv
- Dans la macro VO_Synthese_EEQ : les traitements suivants sont effectués : synthèse sur plusieurs onglets et enregistrement au format .xlsx
Comment réaliser la sélection ou l'ouverture de chaque fichier pour l'exécution de la macro ?
Cordialement.

 

[Balot57]

Re : Executer une macro sur plusieurs classeurs

Bonjour,
J'ai eu le même problème que toi récemment et j'ai utilisé les infos du lien ci-dessous pour le régler. Il explique comment savoir quels fichiers composent un répertoire. Après, il faudra que tu détermines ton système de stockage des chemins de fichiers et de faire une boucle dessus (pour ma part, j'avais choisi de remplir un tableau).
Compter le nombre de fichiers dans un repertoire ? [excel/vba] - VB/VBA/VBS - Programmation - FORUM HardWare.fr

 

[MichD]

Re : Executer une macro sur plusieurs classeurs

Bonjour

A ) La méthode FileSearch n'existe plus pour les versions Excel 2007 et 2010

B ) Voici un exemple, comment traiter tous les fichiers .csv d'un répertoire et ajouter
Les données à la suite des autres dans la feuille du classeur que l'on a choisi.

C ) Il existe plus d'une façon de traiter des documents .csv, ce qui suit n'est qu'un exemple...

'----------------------------------------
Sub test()
Dim Répertoire As String, Fichier As String
Dim Sep As String, Feuille As String

'***********Définir les variables***************
Feuille = "Feuil1" 'Nom de la feuille
                   'où seront copiées les données

'Répertoire où sont les fichiers .csv
Répertoire = "C:\Users\AAIGOUI\Desktop\EEQ VO\"
'Séparateur d'éléments utilisé dans le fichier texte
Sep = ";"
'***************************************************

Application.ScreenUpdating = False
Fichier = Dir(Répertoire & "*.csv")
Do While Fichier <> ""
    Call MaMacro(Répertoire & Fichier, Feuille, Sep)
    Fichier = Dir()
Loop
Application.ScreenUpdating = True
End Sub
'----------------------------------------
Sub MaMacro(CheminEtFichier As String, _
Feuille As String, Sep As String)

Dim A As Integer, T As Variant
Dim Arr As Variant
Dim WholeLine As String, FName As String

With Worksheets(Feuille)
    If .Range("A1") = "" Then
        A = 1
    Else
        A = .Range("A65536").End(xlUp)(2).Row
    End If
    FName = CheminEtFichier
    Open FName For Input Access Read As #1
    While Not EOF(1)
        Line Input #1, WholeLine
        T = Split(WholeLine, Sep)
        .Range("A" & A).Resize(, UBound(T) + 1) = T
        A = A + 1
    Wend
    Close #1
End With
End Sub
'----------------------------------------

 

[nonoTT]

Re : Executer une macro sur plusieurs classeurs

Bonjour et merci de ta réponse.
Afin de mieux comprendre ta macro, pourrais tu m'expliquer ce que réalise la macro suivante :

Sub MaMacro(CheminEtFichier As String, _
Feuille As String, Sep As String)

Dim A As Integer, T As Variant
Dim Arr As Variant
Dim WholeLine As String, FName As String

With Worksheets(Feuille)
    If .Range("A1") = "" Then
        A = 1
    Else
        A = .Range("A65536").End(xlUp)(2).Row
    End If
    FName = CheminEtFichier
    Open FName For Input Access Read As #1
    While Not EOF(1)
        Line Input #1, WholeLine
        T = Split(WholeLine, Sep)
        .Range("A" & A).Resize(, UBound(T) + 1) = T
        A = A + 1
    Wend
    Close #1
End With
End Sub

Merci

 

[nonoTT]

Re : Executer une macro sur plusieurs classeurs

En fait je souhaiterais que la macro s'exécute (voir premier msg) :
- pour chaque fichier .csv individuel
- qu'elle enregistre chaque fichier traité en xlsx (comme dans la macro)
Je ne souhaite pas qu'elle synthétise les données dans le même classeur.
Cdt

 

[MichD]

Re : Executer une macro sur plusieurs classeurs

'--------------------------------------

Sub MaMacro(CheminEtFichier As String, _
Feuille As String, Sep As String)

Dim A As Integer, T As Variant
Dim Arr As Variant
Dim WholeLine As String, FName As String

'En utilisant la feuille que tu passes en paramètre à la procédure
With Worksheets(Feuille)
    'Déterminer la première cellule disponible de la feuille d'où débutera la
    'copie des données des fichiers .csv
    If .Range("A1") = "" Then
        A = 1
    Else
        A = .Range("A65536").End(xlUp)(2).Row
    End If
    
    FName = CheminEtFichier
    'ouverture du fichier .CSV en lecture seulement...
    Open FName For Input Access Read As #1
    'Début d'une boucle se terminant à la fin du fichier
    While Not EOF(1)
        'Mettre dans la variable à chaque boucle la ligne lu dans la variable WholeLine
        Line Input #1, WholeLine
        'Place dans une variable Tableau(array) chacun des éléments basé sur le séparateur d'éléments "sep" utilisé dans le fichier
        T = Split(WholeLine, Sep)
         'Copie du tableau (t) vers la feuille de calcul
        .Range("A" & A).Resize(, UBound(T) + 1) = T
        'Compteur permettant de passer à la ligne suivante dans la feuille de calcul.
        A = A + 1
    Wend
    'Fermeture du fichier
    Close #1
End With
End Sub 
'--------------------------------------

 

[nonoTT]

Re : Executer une macro sur plusieurs classeurs

Merci je commence à comprendre.
Et pour exécuter la macro VO_Synthese_EEQ sur chaque fichier CSV et les enregistrer en XLSX, est ce possible à partir de cette macro ?
Comment faire ?
Merci

 

[MichD]

Re : Executer une macro sur plusieurs classeurs

Ce n'est qu'une façon de faire, un exemple :

'----------------------------------------------
Sub test()
 Dim Répertoire As String, Fichier As String
 Dim Sep As String, Feuille As String
 Dim NomNouveauFichier As String
 
'***********Définir les variables***************
'Répertoire où sont les fichiers .csv
 Répertoire = "c:\Users\DM\Documents\" ' "C:\Users\AAIGOUI\Desktop\EEQ VO\"
 'Séparateur d'éléments utilisé dans le fichier texte
 Sep = ";"
 '***************************************************
 
Application.ScreenUpdating = False
Fichier = Dir(Répertoire & "*.csv")
Do While Fichier <> ""
    NomNouveauFichier = Left(Fichier, Len(Fichier) - 4) & ".xls"
    Call MaMacro(Répertoire, Fichier, NomNouveauFichier, Sep)
    Fichier = Dir()
Loop
Application.ScreenUpdating = True
End Sub

Sub MaMacro(Chemin As String, Fichier As String, _
    NomNouveauFichier As String, Sep As String)
 
Dim A As Integer, T As Variant
Dim Arr As Variant, Wk As Workbook
Dim WholeLine As String
 
'Ajoute un classeur avec seulement une feuille
Set Wk = Workbooks.Add(-4167)
'Baptise le nom de la feuille selon le nom du fichier
Wk.Worksheets(1).Name = Left(Fichier, Len(Fichier) - 4)
With Wk.Worksheets(1)
    Open Chemin & Fichier For Input Access Read As #1
    A = 1
    While Not EOF(1)
        Line Input #1, WholeLine
        T = Split(WholeLine, Sep)
        .Range("A" & A).Resize(, UBound(T) + 1) = T
        A = A + 1
    Wend
    Close #1
End With
'Enregistrement du nouveau fichier au nom du fichier .csv
'dans le même répertoire et écrase le fichier si un fichier
'portant ce nom est déjà présent.
Application.DisplayAlerts = False
Wk.SaveAs Chemin & NomNouveauFichier
Application.DisplayAlerts = True
End Sub
'-----------------------------------------------