fusionner plusieurs classeurs (avec plusieurs feuilles) dans un classeur / VBA

vinzdu16

XLDnaute Junior
Bonjour

J'ai une dizaine de classeur avec plusieurs feuilles dans chacun d'entre eux.
comment regrouper toutes les feuilles de tous les classeurs dans un seul classeur en VBA ?

Merci:eek:

vinz
 

sr94

XLDnaute Occasionnel
Re : fusionner plusieurs classeurs (avec plusieurs feuilles) dans un classeur / VBA

Bonjour

j'ai posté un message similaire il y a très peu de temps, regarde dans les discussion de ce matin "Fusionner plusieurs classeurs"

Merci
 

vinzdu16

XLDnaute Junior
Re : fusionner plusieurs classeurs (avec plusieurs feuilles) dans un classeur / VBA

Bonjour

Merci pour le code.

Sub consolide()
ChDir ActiveWorkbook.Path
Set classeurMaitre = ActiveWorkbook
sup
compteur = 1
nf = Dir("*.xls")
Do While nf <> ""
If nf <> classeurMaitre.Name Then
Workbooks.Open Filename:=nf
For k = 1 To Sheets.Count
Sheets(k).Copy After:=classeurMaitre.Sheets(classeurMaitre.Sheets.Count)
classeurMaitre.Sheets(classeurMaitre.Sheets.Count).Name = "Mapage" & compteur
compteur = compteur + 1
Next k
Workbooks(nf).Close False
End If
nf = Dir
Loop
End Sub

Sub sup()
Application.DisplayAlerts = False
If Sheets.Count > 1 Then
Sheets("Accueil").Move before:=Sheets(1)
Sheets(2).Select
For i = 2 To Sheets.Count
ActiveSheet.Delete
Next i
End If
End Sub


Néanmoins je me heurte à 3 Pb
- Je souhaite garder le nom des onglets d'origine
- Cela crée un bug : des onglets sont copié jusqu'à 32 exemplaires
- Cela ne sélectionne pas tous les fichiers du répertoire (j'ai l'impression que cela tourne en boucle sur 3 ou 4 fichiers

Peut on y remédier ?

Merci

Vinz
 

vinzdu16

XLDnaute Junior
Re : fusionner plusieurs classeurs (avec plusieurs feuilles) dans un classeur / VBA

Bonjour

Je viens de trouver la solution comme suit:

Sub consolide()
Dim rep As String, classeurMaitre As Workbook, wk As Workbook
Dim compteur As Integer, k As Integer, nf As String
Call sup
Application.EnableEvents = False
Application.DisplayAlerts = False
rep = ActiveWorkbook.Path & "\"
Set classeurMaitre = ActiveWorkbook
compteur = 1
nf = Dir(rep & "*.xls")
While nf <> ""
If nf <> classeurMaitre.Name Then
Workbooks.Open Filename:=rep & nf
Set wk = ActiveWorkbook
For k = 1 To Sheets.Count
classeurMaitre.Sheets.Add After:=classeurMaitre.Sheets(classeurMaitre.Sheets.Count)
classeurMaitre.Sheets(classeurMaitre.Sheets.Count).Name = "Mapage" & compteur
wk.Sheets(k).UsedRange.Copy Destination:=classeurMaitre.Sheets("Mapage" & compteur).[A1]
compteur = compteur + 1
Next k
Workbooks(nf).Close False
End If
nf = Dir
Wend
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
Sub sup()
Dim i As Integer
Application.DisplayAlerts = False
For i = Sheets.Count To 1 Step -1
If Sheets(i).Name <> "Accueil" Then
Sheets(i).Delete
End If
Next i
Application.DisplayAlerts = True
End Sub

Mais reste 2 Pb
- Cela va jusqu'à 50 onglet en boucle
- Comment conserver le nom de l'onglet d'origine ?

Vinz
 

Discussions similaires

Statistiques des forums

Discussions
312 294
Messages
2 086 920
Membres
103 404
dernier inscrit
sultan87