Macro qui s'effectue sur plusieurs fichiers .xlsx en même temps

Résolu
bassmart Messages postés 281 Date d'inscription   Statut Membre Dernière intervention   -  
bassmart Messages postés 281 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour à tous!

J'ai fait un code, avec l'aide du forum, qui ouvre un fichier .xlsx, qui copie les données se trouvant dans les colonnes A, B et C sur les lignes suivantes jusqu'à la prochaine ligne contenant une nouvelle valeur et ce, sur toutes les feuilles comprises du fichier. Ensuite, la macro affiche toutes les colonnes masqués entre les colonnes "E" et "O".

Ça fonctionne très bien, un fichier à la fois!

Mais j'ai eu une demande pour qu'il réalise l'opération sur plusieurs fichiers en même temps et non pas un à la fois. Je me suis donc mis à plancher sur le dossier.

J'ai essayé un code pour l'ouverture de plusieurs fichiers à la fois, qui fonctionne. Il ouvre tous les fichiers sélectionnés, mais lorsqu'il effectue l'opération de copie et d'affichage des colonnes, il effectue la macro seulement sur le premier fichier ouvert. À la fin de la macro, je veux pouvoir sauvegarder une copie de tous les fichiers modifiés dans un nouvel onglet du répertoire qui s'appellerait "Transfert", si possible! ("M:\Entrepot\BDFS\1_Piézomètres\Répertoire ouvert\Transfert") ou le "répertoire ouvert" correspond au nom du répertoire source des fichiers ouvert.

Voici mon code:
Private Sub CommandButton1_Click()

Dim nombre As Integer
Dim Motdepasse As String
Dim QuelFichier()
Dim Chemin As String, Fichier As String

'If Not Application.Dialogs(xlDialogOpen).Show("M:\Entrepot\BDFS\1_Piézomètres") Then Exit Sub

ChDrive "m"
ChDir "M:\Entrepot\BDFS\1_Piézomètres\"

QuelFichier = Application.GetOpenFilename(, , , , True)
    If IsArray(QuelFichier) Then
        For i = LBound(QuelFichier, 1) To UBound(QuelFichier, 1)
            Workbooks.Open QuelFichier(i)
        Next i
    Else
        MsgBox "Annuler"
    End If


Application.ScreenUpdating = False

nombre = ActiveWorkbook.Sheets.Count
For i = 2 To nombre
Worksheets(i).Unprotect
Next i

For x = 2 To Sheets.Count - 1
    With Sheets(x)
    Sheets(x).Select
    Columns("E:O").Select
    Selection.EntireColumn.Hidden = False
    derlig = .Range("F" & Rows.Count).End(xlUp).row
        For N = 2 To derlig
            If .Range("D" & N) <> "" Then
                If .Range("A" & N) <> "" Then
                    TInfos = .Range("A" & N & ":C" & N)
                Else
                    .Range("A" & N & ":C" & N) = TInfos
                End If
            End If
        Next N
    Sheets(x).Range("A2").Select
    
    End With
    
Next x   


nombre = ActiveWorkbook.Sheets.Count
For i = 2 To nombre
Worksheets(i).Protect 
Next i

UserForm1.Hide

Chemin = "M:\Entrepot\BDFS\1_Piézomètres\"
Fichier = "Nomclasseur_" & Format("traité") & ".xlsx"
ActiveWorkbook.SaveCopyAs Chemin & Fichier

'Application.Dialogs(xlDialogSaveAs).Show ("M:\Entrepot\BDFS\1_Piézomètres\")

ThisWorkbook.Saved = True
Application.ScreenUpdating = True
'UserForm2.Show
    
End Sub
A voir également:

1 réponse

Réponse 1 / 1
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Bonjour,

Macro qui s'effectue sur plusieurs fichiers .xlsx en même temps

Ce sera toujours un fichier a la fois, un apres l'autre 

Private Sub CommandButton1_Click()
    Dim nombre As Integer
    Dim Motdepasse As String
    Dim QuelFichier()
    Dim Chemin As String, Fichier As String

    'If Not Application.Dialogs(xlDialogOpen).Show("M:\Entrepot\BDFS\1_Piézomètres") Then Exit Sub

    ChDrive "m"
    ChDir "M:\Entrepot\BDFS\1_Piézomètres\"
    QuelFichier = Application.GetOpenFilename(, , , , True)
    If IsArray(QuelFichier) Then
        For i = LBound(QuelFichier, 1) To UBound(QuelFichier, 1)
            Workbooks.Open QuelFichier(i)
            '-------------------------------------------
            Application.ScreenUpdating = False
            nombre = ActiveWorkbook.Sheets.Count
            For n = 2 To nombre
                Worksheets(n).Unprotect
            Next n
            For x = 2 To Sheets.Count - 1
                With Sheets(x)
                    Sheets(x).Select
                    Columns("E:O").Select
                    Selection.EntireColumn.Hidden = False
                    derlig = .Range("F" & Rows.Count).End(xlUp).Row
                    For n = 2 To derlig
                        If .Range("D" & n) <> "" Then
                            If .Range("A" & n) <> "" Then
                                TInfos = .Range("A" & n & ":C" & n)
                            Else
                                .Range("A" & n & ":C" & n) = TInfos
                            End If
                        End If
                    Next n
                    Sheets(x).Range("A2").Select
                End With
    
            Next x
            nombre = ActiveWorkbook.Sheets.Count
            For n = 2 To nombre
                Worksheets(n).Protect
            Next n
            Chemin = "M:\Entrepot\BDFS\1_Piézomètres\"
            Fichier = "Nomclasseur_" & Format("traité") & ".xlsx"
            ActiveWorkbook.SaveCopyAs Chemin & Fichier
            '-------------------------------------------
        Next i
    Else
        MsgBox "Annuler"
    End If
    UserForm1.Hide
    'Application.Dialogs(xlDialogSaveAs).Show ("M:\Entrepot\BDFS\1_Piézomètres\")
    ThisWorkbook.Saved = True
    Application.ScreenUpdating = True
    'UserForm2.Show
End Sub
0
bassmart Messages postés 281 Date d'inscription   Statut Membre Dernière intervention   1
 
Merci beaucoup pour la réponse rapide!

Tout fonctionne bien jusqu'au moment de la sauvegarde. Il ne sauvegarde pas automatiquement, il ouvre tous mes fichiers et effectue l'opération de copie et d'affichage des colonnes masqués très bien et après plus rien ne se passe. Normalement, il devrait sauvegarder tous mes fichiers un à un.
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713 > bassmart Messages postés 281 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour,
Ben, ça se situe au niveau de la ligne Fichier=, y a un truc avec format que je peux savoir puisque je n'ai pas vos fichiers !!!!!!!!!!!!!!
0
bassmart Messages postés 281 Date d'inscription   Statut Membre Dernière intervention   1 > f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention  
 
Re,

Sur la ligne Fichier, je voulais qu'il sauve en ajoutant le terme traité dans le nouveau nom du fichier sauvegardé. C'est pourquoi, j'ai inscrit Format("Traité"), mais probablement que ce n'est pas la bonne manière de l'écrire.
0
bassmart Messages postés 281 Date d'inscription   Statut Membre Dernière intervention   1
 
Voici mon fichier.

http://www.cjoint.com/c/FCynDUsRE2o
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713 > bassmart Messages postés 281 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour,

Fichier modifie pour nom classeur_traite

https://www.cjoint.com/c/FCzhQwtprvf
0

Discussions similaires

Durée d'une diapositive animée
bibibibi99 -
bibibibi99 -

2 réponses
35 GO à l'étranger
Laurence -
Laurence -

2 réponses