IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Rassembler les feuilles de tous les classeurs d’un répertoire dans un seul classeur


Sujet :

Macros et VBA Excel

  1. #1
    Membre à l'essai
    Inscrit en
    Février 2008
    Messages
    27
    Détails du profil
    Informations forums :
    Inscription : Février 2008
    Messages : 27
    Points : 12
    Points
    12
    Par défaut Rassembler les feuilles de tous les classeurs d’un répertoire dans un seul classeur
    Bonjour,

    Je cherche une macro qui créera le tableau suivant dans c:\x\synthèse.xls :
    Pour tout les fichiers du répertoire c:\x
    Pour tout les onglets de ces fichiers
    Créer une colonne avec comme entête le nom de l’onglet
    Et alimenter la colonne avec le champ D8: D90 de la feuille.

    Par exemple :
    J’ai deux fichiers : (1) et (2)
    Dans (1) j’ai 3 feuilles : (A) (B) (C)
    Dans (2) j’ai 2 feuilles : (Y) et (Z).

    La macro créera un tableau à 5 colonnes : (A) (B) (C) (Y) (Z)
    Et les valeurs ces colonnes serons les valeurs D8: D90 de chacune de ces feuilles.

    En espérant que votre aide sera aussi efficace que d’habitude
    Cordialement
    Lucci

    Re,

    Pour simplifier le problème j’ai rassemblé les feuilles dans un même fichier. Avec l’enregistreur de macro, pour un onglet ça donne (j’ai retiré les lignes inutiles à mes yeux):
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
        ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
        Sheets("lutte anti escarres").Select
        Range("D8:D90").Select
        Selection.Copy
        ActiveWindow.ScrollWorkbookTabs Position:=xlLast
        Sheets("récap").Select
        Range("C5").Select
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False
        Range("C5").Select
        Application.CutCopyMode = False
        ActiveCell.FormulaR1C1 = "='lutte anti escarres'!R[-4]C[-1]"
        Range("D5").Select
    J’aimerais savoir comment modifier cette macro de manière à répéter la même opération pour chaque onglet (jusqu'à la feuille « récap »).

    Je progresse...
    Pour la propreté du code, j'y regarderai par la suite.
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
     
    'Sub MacroNumUF()
     
    Sheets("récap").Select
    Range("C5").Select
     
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        ws.Select
        Range("C1:C1").Select
        Selection.Copy
        Sheets("récap").Select
        ActiveCell.Cells(1, 1).Offset(0, 1).Select
        ActiveSheet.Paste
    Next ws
     
    Sheets("récap").Select
    Range("C6").Select
     
    Dim w As Worksheet
    For Each w In ActiveWorkbook.Worksheets
        w.Select
        Range("D9:D94").Select
        Selection.Copy
        Sheets("récap").Select
        ActiveCell.Cells(1, 1).Offset(0, 1).Select
        ActiveSheet.Paste
    Next w
     
    End Sub
    En cas de remarques, n'hésitez pas.

    Pour ne pas que "récap" ne se copie elle même ajoutez,
    If ws.Name <> "récap" then
    ...
    End If

    De même pour w...

  2. #2
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    Février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2005
    Messages : 12 464
    Points : 15 543
    Points
    15 543
    Par défaut
    Regarde dans le forum Contribuez Excel et fais une recherche dans ce forum avec "Lister" comme mot clé, tu as 3 réponses qui t'intéressent

    PS - tu peux aussi regarder dans les sources

    NB - Pour compléter une discussion, utilise le bouton Editer

  3. #3
    Membre à l'essai
    Inscrit en
    Février 2008
    Messages
    27
    Détails du profil
    Informations forums :
    Inscription : Février 2008
    Messages : 27
    Points : 12
    Points
    12
    Par défaut
    Merci beaucoup pour tes sources.

    Mais je dois être bigleux, je ne trouve pas.

    Là où j'en suis maintenant, je recherche l'un:
    - Effectuer la macro sur tous les *.xls d'un dossier (et non plus simplement sur les feuilles du classeur courant)
    - avoir une macro qui copie/coller toutes les feuilles des fichiers *.xls situés dans un dossier dans le classeur courant.

    NB - Pour compléter une discussion, utilise le bouton Editer
    Ok, j'arrête de me parler

  4. #4
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    Février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2005
    Messages : 12 464
    Points : 15 543
    Points
    15 543
    Par défaut
    Les liens que je t'ai passés conduisaient sur "comment lister les fichiers d'un répertoire"
    Pour lister les feuilles d'un classeur c'est
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
     
    Sub test(NomFich as string)
         For each LaFeuille in workbooks(NomFich).worksheets
              'pour copier le contenu de chaque feuille à la suite
              DerLig = Workbooks("Recap.xls").Worksheets(LaFeuilleRecap).Cells(Rows.Count, 1).End(xlUp).Row +1
              LaFeuille.usedrange.copy
              Workbooks("Recap.xls").Worksheets(LaFeuilleRecap).Range("A" & derlig).PasteSpecial Paste:=xlValues
         Next
    Où NomFich est le nom de chaque classeur
    Quand tu listes les classeurs d'un répertoire, pour chaque nouveau classeur que tu ouvres, tu lances la macro
    Bonne soirée

  5. #5
    Membre à l'essai
    Inscrit en
    Février 2008
    Messages
    27
    Détails du profil
    Informations forums :
    Inscription : Février 2008
    Messages : 27
    Points : 12
    Points
    12
    Par défaut
    Bonjour,

    Malgré mes essais, je n’y parviens pas.
    Si j’utilise Lister Les Fichiers D'un Répertoire sans hyperlink.xls (issu de vos sources), où et comment intégrer
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    Sub test(NomFich as string)
         For each LaFeuille in workbooks(NomFich).worksheets
              'pour copier le contenu de chaque feuille à la suite
              DerLig = Workbooks("Recap.xls").Worksheets(LaFeuilleRecap).Cells(Rows.Count, 1).End(xlUp).Row +1
              LaFeuille.usedrange.copy
              Workbooks("Recap.xls").Worksheets(LaFeuilleRecap).Range("A" & derlig).PasteSpecial Paste:=xlValues
         Next
    ?

    Merci pour ton aide.

  6. #6
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    Février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2005
    Messages : 12 464
    Points : 15 543
    Points
    15 543
    Par défaut Rassembler les feuilles de tous les classeurs d’un répertoire dans une seule feuille
    Voilà ce que j'utilise mais essaie de comprendre le code
    Ce code nécessite d'activer la référence "Microsoft scripting Runtime" : Dans l'éditeur VBA -> Outils -> Références -> Valider
    Appel détermine le répertoire à ouvrir et crée l'instance de la feuille dans laquelle coller les données à la suite les unes des autres
    ThisWorkbook est le classeur contenant cette feuille et ces macros
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    Sub Appel()
    Dim FL1 As Worksheet, Chemin As String
        Application.ScreenUpdating = False
            Chemin = "D:\xls"
            Set FL1 = ThisWorkbook.Worksheets("FeuilleRecap")
            ouvrir Chemin, FL1
        Application.ScreenUpdating = True
    End Sub
    Ouvrir ... ouvre chaque classeur et appelle Copie en passant le nom du fichier et l'instance de la feuille
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    Sub Ouvrir(Chemin As String, FL1 As Worksheet)
    Dim fs, i As Integer, NomFich As String
        Set fs = Application.FileSearch
        With fs
            .LookIn = Chemin
            .FileType = 4 '1 tous les fichiers, 3 = Doc, 4 = xls,
            If .Execute(SortBy:=msoSortByFileName, _
                SortOrder:=msoSortOrderAscending) > 0 Then
    'Ouverture et traitement des fichiers
                For i = 1 To .FoundFiles.Count
                    Workbooks.Open .FoundFiles(i)
                    DoEvents
                    NomFich = ActiveWorkbook.Name
                    Copie NomFich, FL1
                Next i
            Else
                MsgBox "Aucun fichier n'a été trouvé."
            End If
        End With
        Set fs = Nothing
    End Sub
    Copie réalise la copie de chaque feuille de chaque classeur à la suite, dans FL1
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    Sub Copie(NomFich As String, FL1 As Worksheet)
         For Each LaFeuille In Workbooks(NomFich).Worksheets
            'pour copier le contenu de chaque feuille à la suite
            derlig = FL1.Cells(Rows.Count, 1).End(xlUp).Row + 1
            LaFeuille.UsedRange.Copy
            FL1.Range("A" & derlig).PasteSpecial Paste:=xlValues
            DoEvents
         Next
         'Fermeture du classeur
         ActiveWorkbook.Close False
         DoEvents
    End Sub
    Pour lancer ce code, exécuter Appel
    Bonne journée

    Afin d'éviter d'avoir à valider la référence Microsoft Scripting Runtime, tu peux faire la même chose avec Dir. C'est plus rapide et c'est plus court. Je crois en outre que ça assure la compatibilité avec Excel 2007 (!?!) (que je n'ai pas pour tester)
    Tu remplaces la procédure Ouvrir par celle-ci
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    Sub Ouvrir(Chemin As String, FL1 As Worksheet)
    Dim NomFich As String
        NomFich = Dir(Chemin & "\")
        If NomFich = "" or Right(NomFich, 4) <> ".xls" Then
             MsgBox "Aucun fichier trouvé dans " & chemin & "."
             Exit sub
        endif
        Do While NomFich <> ""
            Workbooks.Open Chemin & "\" & NomFich
            DoEvents
            NomFich = ActiveWorkbook.Name
            Copie NomFich, FL1
            NomFich = Dir
        Loop
    End Sub
    Comme ça tu as le choix
    Bonne journée

  7. #7
    Membre à l'essai
    Inscrit en
    Février 2008
    Messages
    27
    Détails du profil
    Informations forums :
    Inscription : Février 2008
    Messages : 27
    Points : 12
    Points
    12
    Par défaut
    Merci génial.
    Ca fonctionne bien, là j’essaie de modifier ‘copie’ pour ne plus qu’il me colle tout sur la même feuille (j’aimerais que pour chaque feuille copiée, elle soit collé dans un nouvel onglet qui porterait le même nom)

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Voilà ce que j'utilise mais essaie de comprendre le code
    Le problème c’est que je comprends les codes mais j’arrive pas à chier une seule ligne de code par moi même (en VBA).

  8. #8
    Membre à l'essai
    Inscrit en
    Février 2008
    Messages
    27
    Détails du profil
    Informations forums :
    Inscription : Février 2008
    Messages : 27
    Points : 12
    Points
    12
    Par défaut
    Grâce à toi, je suis dans la bonne direction, merci
    Demain je passerai plus de temps dessus, en espérant copier coller mon superbe_code_qui_marche et dégainer la balise [résolu] avant ce week-end.

  9. #9
    Membre à l'essai
    Inscrit en
    Février 2008
    Messages
    27
    Détails du profil
    Informations forums :
    Inscription : Février 2008
    Messages : 27
    Points : 12
    Points
    12
    Par défaut
    Salut,

    J’ai le message d’erreur suivant :
    Erreur de compilation
    Nombre d’argument incorrect ou affectation de propriété incorrecte.
    Il me jaunit Sub Ouvrir(Chemin As String, FL1 As Worksheet)
    Et me sélectionne Copie NomFich, FL1

    Pourtant Chemin et NomFich sont bien des strings et FL1 un classeur…
    Je pense avoir compris le code (pour le prouver j’ai ajouté des commentaires ) et pourtant je n’arrive pas à résoudre ce « bug » .

    Code VBA : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    Sub Appel()
    'On déclare les variables FL1 comme une feuille de calcul et Chemin comme Chaîne de caractères.
    Dim FL1 As Worksheet, Chemin As String
        Application.ScreenUpdating = False
            ' On attribue une valeur (une chaîne de caractères) à Chemin
            Chemin = "C:\Documents and Settings\Lucci\Bureau\Pole"
            'On attribue une valeur (nom d'une feuille) à FL1
            Set FL1 = ThisWorkbook.Worksheets("FeuilleRecap")
            'On appelle la fonction Ouvrir avec comme argument Chemin et FL1 (précédemment défini)
            Ouvrir Chemin, FL1
        Application.ScreenUpdating = True
    End Sub
    Sub Ouvrir(Chemin As String, FL1 As Worksheet)
    'On déclare fs (On ne lui donne pas de type?), i un entier et NomFich une chaîne de caractères
    Dim fs, i As Integer, NomFich As String
        'Set indique que l'on a un objet. Application est cet objet, FileSearch une méthode (a priori elle va permettre de chercher un fichier)
        Set fs = Application.FileSearch
        With fs
            'On utilise fs et on lui applique les méthodes .LookIn (regarder dans) et FileType (qui sélectionne une type de fichier)
            .LookIn = Chemin
            .FileType = 4 '1 tous les fichiers, 3 = Doc, 4 = xls,
            If .Execute(SortBy:=msoSortByFileName, _
                SortOrder:=msoSortOrderAscending) > 0 Then
                'Ouverture et traitement des fichiers pour tout i jusqu'à i=nombre de fichiers
                For i = 1 To .FoundFiles.Count
                    ' Ouvre le fichier/classeur i
                    Workbooks.Open .FoundFiles(i)
                    'exécute les appels en fil d'attente
                    DoEvents
                    'On attribue à NomFich le nom du classeur courant (a l'indice i)
                    NomFich = ActiveWorkbook.Name
                    'on appelle la fonction Copie avec comme paramètre FL1 et NomFich (précédemment définis)
                    Copie NomFich, FL1
                    'le compteur passe au i suivant
                Next i
            Else
                ' Sinon erreur pas de fichier type 4 dans le chemin Chemin
                MsgBox "Aucun fichier n'a été trouvé."
            End If
        'Fin de la boucle With
        End With
        'Dès qu'on a terminé la boucle et que l'indice i=nombre de fichiers fs est vide
        Set fs = Nothing
    End Sub
    Sub Copie(NomFich As String)
        'Pour chaque LaFuille dans le classeur courant (nomfich étant le nom du Worbook actif)
       For Each LaFeuille In Workbooks(NomFich).Worksheets
            'pour copier le contenu de chaque feuille à la suite
            'pas trouvé la signification de derlig, je ne voudrais pas dire n'imp
            derlig = FL1.Cells(Rows.Count, 1).End(xlUp).Row + 1
            'Copier LaFeuille après
            LaFeuille.Copy After:=FL1.Sheets(FL1.Sheets.Count)
            'Copier les colonnes utilisées de la feuille active
            ActiveSheet.UsedRange.Copy
            'Coller/valeurs dans la feuille active en A1
            ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
            'exécute les appels en fil d'attente
            DoEvents
         Next
    End Sub

  10. #10
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    Février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2005
    Messages : 12 464
    Points : 15 543
    Points
    15 543
    Par défaut
    Naturellement ! Tu envoies deux paramètres à copie alors que Copie n'en attend qu'un puisque tu utilises Activesheet

    Copie NomFich, FL1 'appel

    Sub Copie(NomFich As String) 'Attendu

  11. #11
    Membre à l'essai
    Inscrit en
    Février 2008
    Messages
    27
    Détails du profil
    Informations forums :
    Inscription : Février 2008
    Messages : 27
    Points : 12
    Points
    12
    Par défaut
    Ok merci, là c'est bon.
    Mais je tombe maintenant sur le message
    Objet requis
    Sans plus de précision.
    J'imagine que c'est à cause de l'objet LaFeuille qui n'est pas instancié?

    J'ai donc essayé:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
        Dim LaFeuille As Workseet
        Set LaFeuille = ActiveWorkSheet
       For Each LaFeuille In Workbooks(NomFich).Worksheets ...
    Mais j'ai le message suivant:
    Erreur de compilation
    Type défini par l'utilisateur non défini

  12. #12
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    Février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2005
    Messages : 12 464
    Points : 15 543
    Points
    15 543
    Par défaut
    Quand tu copies, copie bien, c'est mieux
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Dim LaFeuille As Worksheet
    Et moi qui croyais que tout le monde connaissait "Sheet"...

  13. #13
    Membre à l'essai
    Inscrit en
    Février 2008
    Messages
    27
    Détails du profil
    Informations forums :
    Inscription : Février 2008
    Messages : 27
    Points : 12
    Points
    12
    Par défaut
    Avec correction de ma sHeet, je retombe sur "objet requis".
    Parfois il est préférable de faire des erreurs, ça donne l’impression de progresser

  14. #14
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    Février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2005
    Messages : 12 464
    Points : 15 543
    Points
    15 543
    Par défaut
    Ce n'est pas ActiveWorkSheet mais activesheet. Tu n'as pas de bouton ?

  15. #15
    Membre à l'essai
    Inscrit en
    Février 2008
    Messages
    27
    Détails du profil
    Informations forums :
    Inscription : Février 2008
    Messages : 27
    Points : 12
    Points
    12
    Par défaut
    Tu n'as pas de bouton ?
    Cool avec F1 j’avais un trombone à la con, mais si on le vire on a le manuel (petit à petit je découvre les habitudes Windows…)


    Si
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    Sub Copie(NomFich As String)
    Dim LaFeuille As Worksheet
    Set LaFeuille = ActiveSheet
       For Each LaFeuille In Workbooks(NomFich).Worksheets
            'pour copier le contenu de chaque feuille à la suite
            'pas trouvé la signification de derlig, je ne voudrais pas dire n'imp
            derlig = FL1.Cells(Rows.Count, 1).End(xlUp).Row + 1
            'Copier LaFeuille après
            LaFeuille.Copy After:=FL1.Sheets(FL1.Sheets.Count)
            'Copier les colonnes utilisées de la feuille active
            ActiveSheet.UsedRange.Copy
            'Coller/valeurs dans la feuille active en A1
            ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
            'exécute les appels en fil d'attente
            DoEvents
         Next
    End Sub
    J’ai
    Objet requis
    Si
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    Dim LaFeuille As Sheet
    Set LaFeuille = ActiveSheet
       For Each LaFeuille In Workbooks(NomFich).Worksheets
            'pour copier le contenu de chaque feuille à la suite
            'pas trouvé la signification de derlig, je ne voudrais pas dire n'imp
            derlig = FL1.Cells(Rows.Count, 1).End(xlUp).Row + 1
            'Copier LaFeuille après
            LaFeuille.Copy After:=FL1.Sheets(FL1.Sheets.Count)
            'Copier les colonnes utilisées de la feuille active
            ActiveSheet.UsedRange.Copy
            'Coller/valeurs dans la feuille active en A1
            ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
            'exécute les appels en fil d'attente
            DoEvents
         Next
    End Sub
    J’ai
    Erreur de compilation
    Type défini par l’utilisateur non défini.
    Merci pour ta patience, ça n’aurait sûrement pas été mon cas

    (EDIT)
    Finalement je pense que le "bug" se trouve sur cette ligne:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    LaFeuille.Copy After:=FL1.Sheets(FL1.Sheets.Count)
    Car si:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    Sub Copie(NomFich As String, FL1 As Worksheet)
       For Each LaFeuille In Workbooks(NomFich).Worksheets
            'pour copier le contenu de chaque feuille à la suite
            'pas trouvé la signification de derlig, je ne voudrais pas dire n'imp
            derlig = FL1.Cells(Rows.Count, 1).End(xlUp).Row + 1
            'Copier LaFeuille après
            LaFeuille.Copy After:=FL1.Sheets(FL1.Sheets.Count)
            'Copier les colonnes utilisées de la feuille active
            ActiveSheet.UsedRange.Copy
            'Coller/valeurs dans la feuille active en A1
            ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
            'exécute les appels en fil d'attente
            DoEvents
         Next
    End Sub
    J'ai
    Erreur de compilation
    Membre de méthode ou de données introuvable

  16. #16
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    Février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2005
    Messages : 12 464
    Points : 15 543
    Points
    15 543
    Par défaut Rassembler les feuilles des fichiers d'un répertoire dans un seul classeur
    J'ai modifié le code afin de copier toutes les feuilles de tous les classeurs situés dans un répertoire en prenant en compte divers éléments.
    Tient désormais compte des feuilles protégées : Deux possibilités
    - Protection sans mot de passe : Déprotège la feuille pour la copie des seules valeurs (macro Copie)
    - Protection avec mot de passe : Génère une erreur récupérée et un message indiquant nom de classeur et de feuille. Ce message n'apparaîtra qu'en fin de macro (Appel)
    Tient compte des classeurs ayant une macro Auto_Open ou Workbook_Open
    Les macros sont désactivées le temps de l'ouverture (macro Ouvrir)
    Tiens compte également les événements relatifs aux feuilles de calculs (macro Copie) (non testé)

    Exécuter la procédure Appel
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    Public msg As String
     
    Sub Appel()
    Dim FL1 As Workbook, Chemin As String
        Application.ScreenUpdating = False
            Chemin = "D:\xls"
            Set FL1 = ThisWorkbook
            Ouvrir Chemin, FL1
        Application.ScreenUpdating = True
        MsgBox "Pour des raisons de protection ou autres, n'ont pu être copiées " & vbCrLf & msg
    End Sub
    Ouverture des fichiers
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    Sub Ouvrir(Chemin As String, FL1 As Workbook)
    Dim NomFich As String
        NomFich = Dir(Chemin & "\")
        If NomFich = "" Or Right(NomFich, 4) <> ".xls" Then
             MsgBox "Aucun fichier trouvé dans " & Chemin & "."
             Exit Sub
        End If
        Do While NomFich <> ""
            Application.EnableEvents = False
                Workbooks.Open Chemin & "\" & NomFich
                DoEvents
            Application.EnableEvents = True
            NomFich = ActiveWorkbook.Name
            Copie NomFich, FL1
            NomFich = Dir
        Loop
    End Sub
    Copie des feuilles
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    Sub Copie(NomFich As String, FL1 As Workbook)
            Application.EnableEvents = False
            For Each LaFeuille In Workbooks(NomFich).Worksheets
                'MsgBox LaFeuille.Name
                On Error Resume Next
                LaFeuille.Copy After:=FL1.Sheets(FL1.Sheets.Count)
                DoEvents
                If ActiveSheet.Protect = True Then ActiveSheet.Unprotect
                ActiveSheet.UsedRange.Copy
                ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
                If Err <> 0 Then
                    msg = msg & NomFich & " feuille " & LaFeuile.Name & vbCrLf
                    Err.Clear
                    On Error GoTo 0
                End If
                DoEvents
            Next
            Application.EnableEvents = True
            'Fermeture du classeur
        Application.DisplayAlerts = False
            Workbooks(NomFich).Close False
        Application.DisplayAlerts = True
        DoEvents
    End Sub
    Les événements liés aux feuilles de calculs n'ont pas été testés cas je n'en ai pas dans les classeurs copiés.
    Reste un éventuel problème de mémoire. J'ai su mais ai oublié comment libérer la mémoire après chaque copie. Je pose la question sur le forum.
    J'ai testé mon code et ai arrêté la macro à 196 feuilles copiées.

    Tu testes de ton côté et tu me dis si tu as une erreur.
    A+

  17. #17
    Membre à l'essai
    Inscrit en
    Février 2008
    Messages
    27
    Détails du profil
    Informations forums :
    Inscription : Février 2008
    Messages : 27
    Points : 12
    Points
    12
    Par défaut
    Merci beaucoup, mais je ne pourrai tester que Lundi.
    Je vais profiter du week end pour bouquiner sur le VBA.

  18. #18
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    Février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2005
    Messages : 12 464
    Points : 15 543
    Points
    15 543
    Par défaut
    J'ai modifié le sujet de la discussion pour qu'il corresponde à ta "vraie" demande
    Bon week-end

  19. #19
    Membre à l'essai
    Inscrit en
    Février 2008
    Messages
    27
    Détails du profil
    Informations forums :
    Inscription : Février 2008
    Messages : 27
    Points : 12
    Points
    12
    Par défaut
    Ca fonctionne au poil
    je n'arrive plus à faire fonctionner la première macro, mais je devrais trouver seul. J'édite ce soir mon premier post pour que le visiteur ne soit pas trop pommé...

    Merci.

    Passes une bonne semaine.

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [Batch] Connexion SFTP + download de tous les fichiers ET tous les répertoires
    Par gazza dans le forum Scripts/Batch
    Réponses: 2
    Dernier message: 06/03/2014, 13h45
  2. lister tous les membres de tous les groupes AD
    Par fbb53 dans le forum VBScript
    Réponses: 1
    Dernier message: 03/10/2011, 11h24
  3. VBA Excel : fusion de certaines feuilles de tous les classeurs
    Par toto92 dans le forum Macros et VBA Excel
    Réponses: 12
    Dernier message: 25/10/2007, 17h44
  4. Réponses: 9
    Dernier message: 16/10/2006, 16h35
  5. Réponses: 1
    Dernier message: 19/08/2006, 10h27

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo