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

Résolu/Fermé

bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 - 23 mars 2016 à 17:50
bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 - 29 mars 2016 à 19:58

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:

Macro qui s'effectue sur plusieurs fichiers .xlsx en même temps
Renommer plusieurs fichiers en même temps - Guide
Fichier xlsx - Télécharger - Tableur
Comment ouvrir un fichier xlsx ? - Guide
Wetransfer gratuit fichiers lourd - Guide
Blocage agriculteur carte en temps réel - Guide

1 réponse

Réponse 1 / 1

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 702
23 mars 2016 à 19:51

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

bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 1
24 mars 2016 à 12:46

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.

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 702 > bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023
24 mars 2016 à 13:10

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 !!!!!!!!!!!!!!

bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 1 > f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024
24 mars 2016 à 13:51

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.

bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 1
24 mars 2016 à 14:31

Voici mon fichier.

http://www.cjoint.com/c/FCynDUsRE2o

Bonjour,

Fichier modifie pour nom classeur_traite

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

Discussions similaires

Acces à snapchat temporairement désactivé

Chemin Logo du site de la Cité de l'espace

Discussions similaires

Newsletters