VBA Excel : fusion de certaines feuilles de tous les classeurs

**toto92** · 24/10/2007, 09h08

Bonjour

Je cherche à fusionner certaines feuilles ( nom = "detail" ou "sheet1" ) de tous les classeurs vers un seul classeur
Comment faire ?
ci dessous la source :

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
Sub fusion()
        On Error GoTo gesterreur
        Dim VarListeFichiers As Variant, VarFichier As Variant, WkClasseur As Workbook, WkFinal As Workbook, WsFeuille As Worksheet
 
        VarListeFichiers = Application.GetOpenFilename(filefilter:="Classeurs eXceL,*.xls", Title:="Choisissez les Classeurs à récupérer", MultiSelect:=True)
        If VarType(VarListeFichiers) = vbBoolean Then MsgBox "Abandon !": Exit Sub     'pour identifier le bouton annuler
        Set WkFinal = Workbooks.Add 'générer le classeur final
 
        For Each VarFichier In VarListeFichiers
           Set WkClasseur = Workbooks.Open(Filename:=VarFichier)
           For Each WsFeuille In WkClasseur.Worksheets
                       WsFeuille.Move before:=WkFinal.Worksheets(1)
                   Next WsFeuille
           WkClasseur.Close savechanges:=False
        Next VarFichier
        Exit Sub
gesterreur:
        'classeur vide
        If Err.Number = -2147221080 Then
        Resume Next
        End If
         End Sub

Merci

**Jean-Philippe André** · 24/10/2007, 09h09

bonjour, tu nous donnes du code, est-ce pour le tester ? il ne fonctionne pas ? qu'attends-tu de nous stp ?

**ouskel'n'or** · 24/10/2007, 09h12

Salut Toto,
Déjà sans regarder ton code non balisé, tu peux regarder ici, mais le sujet a été traité de nombreuses fos sur le forum.
Pour baliser ton code -> Bouton Editer en bas ce ton message -> Sélection du code -> 1 clic sur l'icône # en mode d'édition. C'est aussi simple

Bonne journée

**ouskel'n'or** · 24/10/2007, 09h49

Tu peux effectivement avoir un problème si tu ne laisses pas le temps au système de déplacer chaque feuille. Ajoute un DoEvents aux endroits qui vont bien et refais le test

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
      For Each VarFichier In VarListeFichiers
           Set WkClasseur = Workbooks.Open(Filename:=VarFichier)
           DoEvents
           For Each WsFeuille In WkClasseur.Worksheets
                WsFeuille.Move before:=WkFinal.Worksheets(1)
                DoEvents
           Next WsFeuille
           WkClasseur.Close savechanges:=False
           DoEvents
      Next VarFichier

A+

NB - Même si tu en as un de trop, DoEvents ne ralentit pas le code plus que nécessaire

**toto92** · 24/10/2007, 17h02

Pas d'effets avec DoEvents ( merci quand meme car je ne le savais pas )

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
        Sub fusion1()
        On Error GoTo gesterreur
        Dim VarListeFichiers As Variant, VarFichier As Variant, WkClasseur As Workbook, WkFinal As Workbook, WsFeuille As Worksheet
 
        VarListeFichiers = Application.GetOpenFilename(filefilter:="Classeurs eXceL,*.xls", Title:="Choisissez les Classeurs à récupérer", MultiSelect:=True)
        If VarType(VarListeFichiers) = vbBoolean Then MsgBox "Abandon !": Exit Sub     'pour identifier le bouton annuler
        Set WkFinal = Workbooks.Add 'générer le classeur final
 
        For Each VarFichier In VarListeFichiers
           Set WkClasseur = Workbooks.Open(Filename:=VarFichier)
           'For Each WsFeuille In WkClasseur.Worksheets
                       WsFeuille.Move before:=WkFinal.Worksheets(1)
            'Next WsFeuille
           WkClasseur.Close savechanges:=False
        Next VarFichier
        Exit Sub
gesterreur:
        'classeur vide
        If Err.Number = -2147221080 Then
        Resume Next
        End If
 
        End Sub

J'ai des classeurs .. certains classeurs avec quelques feuilles qui ont pour nom comme : "sheet1" "sheet2" "sheet3" , d'autres classeurs ( les plus recents ) avec quelques feuilles qui ont pour nom comme : "detail" "mise en service" "sheet3" )

J'ai essayé avec ce code entier ( y compris les 2 lignes rouges ) ==> ca marche mais ca copie toutes les feuilles de tous les classeurs

Je voudrai selectionner la premiere feuille ( nom = "detail" ou nom = "sheet1" selon les classeurs ) de chaque classeur

J ai essayé avec ce code sans les 2 lignes rouges ==> Normalement ca lit sur chaque classeur : Que la 1ere feuille qui s'appelle soit "sheet1" soit "detail" ( en fait c'est la premier feuille dont on a renommé de "sheet1" en "detail" sur certains classeurs
mais mon code ouvre le premier classeur , copie la 1ere feuille , colle sur un nouveau classeur et s'arrete ! ( ne passe pas aux autres classeurs )

Merci

**ouskel'n'or** · 24/10/2007, 17h32

En effet, tes remarques se justifient si tu ne précises pas que ce ne sont que deux feuilles qui t'intéressent "detail" ou "sheet1"... Suffit d'ajouter les conditions :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
           For Each WsFeuille In WkClasseur.Worksheets
                if lcase(WsFeuille.name) = "detail" or lcase(WsFeuille.name) = "sheet1" then _
                       WsFeuille.Move before:=WkFinal.Worksheets(1)
           Next WsFeuille

Tu dis
A+

**alsimbad** · 24/10/2007, 18h51

même pas.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Set WkClasseur = Workbooks.Open(Filename:=VarFichier)
         sheet(1).Move before:=WkFinal.Worksheets(1)
           WkClasseur.Close savechanges:=False

ça suffit largement. toutes tes feuilles ne s'appelent pas détail, mais toutes s'appelle sheet(1). si par hasard, il y a un classeur ou cette fameuse feuille a été déplacé ou suprimée, il y aura toujour une sheet1 dans le classeur, donc pas d'erreur, et si jamais, il y a une qui viens et qui n'est pas la bonne, sa position dans le classeur final t'indiquera de quel classeur ell provient

**ouskel'n'or** · 25/10/2007, 11h16

Envoyé par alsimbad

même pas.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Set WkClasseur = Workbooks.Open(Filename:=VarFichier)
         sheet(1).Move before:=WkFinal.Worksheets(1)
           WkClasseur.Close savechanges:=False

ça suffit largement. toutes tes feuilles ne s'appelent pas détail, mais toutes s'appelle sheet(1). si par hasard, il y a un classeur ou cette fameuse feuille a été déplacé ou suprimée, il y aura toujour une sheet1 dans le classeur, donc pas d'erreur, et si jamais, il y a une qui viens et qui n'est pas la bonne, sa position dans le classeur final t'indiquera de quel classeur ell provient

et sheet1 aura été copiée par erreur mais sans erreur de code

Bonjour alsimbad,
Ok pour ton raisonnement... si la feuille "Détail" a été, dès l'origine "Sheet(1)" mais si ce n'est pas le cas => problème. Compte tenu de la procédure qui ouvre les fichiers, effectue des copies de feuilles, ferme les fichiers, un test sur le nom de feuille ne coûte pas grand chose en termes de temps, et est tout de même une meilleure sécurité. C'est pourquoi je le maintiendrais

**toto92** · 25/10/2007, 13h15

**alsimbad** · 25/10/2007, 16h46

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
           For Each WsFeuille In WkClasseur.Worksheets
                if lcase(WsFeuille.name) = "detail" or lcase(WsFeuille.name) = "sheet1" then _
                       WsFeuille.Move before:=WkFinal.Worksheets(1)
           Next WsFeuille

oui, mais dans ton cas, tu ne prend en compte que les noms des feuilles. donc si la feuille ne s"appelle ni détail ni sheet1 (et dans ce cas, on est bien d'accord, ce sheet1 ne parle pas de la position de la feuille, mais seulement de son nom bapteme), tu as donc une erreur. mais tu ne sais pas ou est l'erreur. si tu as traité 1000 fichiers, tu vas a la peche. il vaudrais peut etre mieux quand même ajouter un else et soit importer quand meme la shhet(1)-positionel- soit une indication qualquonque du fichier en cause