Fusionner 180 fichiers excel à plusieurs feuil
Résolu
LP
-
gbinforme Messages postés 14930 Date d'inscription Statut Contributeur Dernière intervention -
gbinforme Messages postés 14930 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour,
Je reçois 10 fichiers excel tous du même format qui comportent chacun le même nombre d'onglet (soit 4). Je voudrais ''fusionner'' ses 10 fichiers en une seul qui comporterait 40 onglets (soit 10 fichiers x 4 onglets).
J'ai utilisé le macro suivant :
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
Or, ce macro ne semble utiliser que le 1er onglet des fichiers (en plus de créer 5 copies non désiré d'onglets).
Peut-on modifier ce macro pour qu'il réponde à mes besoins, y a-t-il d'autres solutions ?
Merci !!
LP
Je reçois 10 fichiers excel tous du même format qui comportent chacun le même nombre d'onglet (soit 4). Je voudrais ''fusionner'' ses 10 fichiers en une seul qui comporterait 40 onglets (soit 10 fichiers x 4 onglets).
J'ai utilisé le macro suivant :
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
Or, ce macro ne semble utiliser que le 1er onglet des fichiers (en plus de créer 5 copies non désiré d'onglets).
Peut-on modifier ce macro pour qu'il réponde à mes besoins, y a-t-il d'autres solutions ?
Merci !!
LP
3 réponses
-
Bonjour,
Voici la correction testée que je te propose :Option Explicit
--
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
Toujours zen
La perfection est atteinte, non pas lorsqu'il n'y a plus rien à ajouter, mais lorsqu'il n'y a plus rien à retirer. Antoine de Saint-Exupéry -
Bonjour,
Tu remplaces ceci :wk.Sheets(k).UsedRange.Copy Destination:=classeurMaitre.Sheets("Mapage" & compteur).[A1]parwk.Sheets(k).UsedRange.Copy
et cela devrait le faire.
classeurMaitre.Sheets("Mapage" & compteur).[A1].PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False -
Malade !!! Ça fonctionne très bien, mais est-il possible qu'en plus de fusionner les fichiers, ils conservent leurs mise en page !? (largeur de colonne, etc.) ?
