Excel : Fusionner plusieurs fichier XLS Résolu/Fermé

Question

Bonjour à tous, 

Je suis sous Excel 2007 

J'ai plusieurs fichier XLS où il y a des tableaux. 

J'aimerai savoir s'il est possible, par une quelconque manière, de faire en sorte que tous les fichier sélectionnés XLS s'ouvre dans un seule et même fichier XLS. 

De se fait, tous les tableaux se "suivrons" en gardant leur colonnes identiques. 



Il y a bien sur le copier/coller, mais j'ai énormément de fichier XLS à traiter... 

Si vous avez des solution pour Excel 2010/2013, je suis preneur :) 

Merci à tous.

tompols · Accepted Answer

Salut, en modifiant légerement la macro donnée plus haut (modifs en gras): Sub regroupe() Dim chemin As String ' classeur regroupé Dim rep As String ' répertoire à traiter Dim fic As String ' classeur regroupé Dim ligne As Long ' ligne écriture Dim nbc As Integer ' nombre de classeurs Dim Wf As Worksheet ' feuille regroupement Dim Wl As Worksheet ' feuille regroupée rep = ThisWorkbook.Path & "\" Application.ScreenUpdating = False Application.EnableEvents = False Application.DisplayAlerts = False On Error GoTo fin Set Wf = ThisWorkbook.ActiveSheet ' variable feuille groupe Wf.Cells.ClearContents nbc = 0: nbf = 0 ' initialisation variables ligne = 1 fic = Dir(rep & "*.xls") ' recherche fichiers While fic <> "" If fic <> ThisWorkbook.Name Then chemin = rep & fic ' chemin fichiers Workbooks.Open chemin, 0 ' ouverture Set Wl = ActiveWorkbook.Sheets(1) Wl.Copy After:=Wf Workbooks(fic).Close SaveChanges:=False ' Fermeture du classeur nbc = nbc + 1 End If fic = Dir Wend fin: MsgBox nbc & " classeurs regroupés" Application.ScreenUpdating = True Application.EnableEvents = True Application.DisplayAlerts = True End Sub A+ On entend par une belle solution, la solution simple et facile d'un problème difficile et compliqué

Morgothal · Answer

Bonjour,
Soyons précis, un fichier xls est un classeur Excel qui contient des feuilles de calcul.
Ton besoin est de mettre toutes les feuilles de tous les classeurs dans un seul classeur ?
Ou de fusionner toutes les feuilles pour ne faire qu'une seule feuille excel en un classeur ?

piroc · Answer

Ton besoin est de mettre toutes les feuilles de tous les classeurs dans un seul classeur ? 

Oui, sachant que je n'est q'une feuille par classeur

C'est un peut plus clair ? :) sinon je re explique en détail.

Morgothal · Answer

Re, Voici une macro de gbinforme qui fonctionne chez moi (une macro trouvée en prenant le premier résultat d'une recherche google au fait ;)) Attention, il faut que le classeur où tout sera regroupé s'appelle "global.xls" et qu'il soit placé dans le même dossier que tous les autres: Sub regroupe() Dim chemin As String ' classeur regroupé Dim rep As String ' répertoire à traiter Dim fic As String ' classeur regroupé Dim ligne As Long ' ligne écriture Dim nbc As Integer ' nombre de classeurs Dim nbf As Integer ' nombre de feuilles Dim nbl As Integer ' nombre de lignes Dim c As Integer ' nombre de colonnes Dim l As Long ' ligne lecture Dim Wf As Worksheet ' feuille regroupement Dim Wl As Worksheet ' feuille regroupée rep = ThisWorkbook.Path & "\" Application.ScreenUpdating = False Application.EnableEvents = False Application.DisplayAlerts = False On Error GoTo fin Set Wf = ThisWorkbook.ActiveSheet ' variable feuille groupe Wf.Cells.ClearContents nbc = 0: nbf = 0 ' initialisation variables ligne = 1 fic = Dir(rep & "*.xls") ' recherche fichiers While fic <> "" If fic <> ThisWorkbook.Name Then chemin = rep & fic ' chemin fichiers Workbooks.Open chemin, 0 ' ouverture Set Wl = ActiveWorkbook.Sheets(1) nbl = Wl.UsedRange.Rows.Count c = Wl.UsedRange.Columns.Count If ligne > 2 Then l = 2 Else l = 1 ' une seule fois le titre Wl.Cells(l, 1).Resize(nbl, c).Copy Destination:=Wf.Cells(ligne, 1) ligne = ligne + nbl - l + 1 nbf = nbf + 1 ActiveWorkbook.Close SaveChanges:=False ' Fermeture du classeur nbc = nbc + 1 End If fic = Dir Wend fin: MsgBox nbc & " classeurs regroupés avec " & nbf & " feuilles et " & ligne & " lignes" Application.ScreenUpdating = True Application.EnableEvents = True Application.DisplayAlerts = True End Sub

Morgothal · Answer

J'ai bien corrigé et simplifié la macro plus haut, j'étais aussi allé un peu vite avec la macro de gbinforme, merci tompols :) Celle-ci marche bien, en créant une nouvelle feuille pour chaque classeur à insérer : Sub regroupe() Dim chemin As String Dim rep As String Dim fic As String Dim Wf As Workbook Dim source As Range rep = ThisWorkbook.Path & "\" Application.ScreenUpdating = False Application.EnableEvents = False Application.DisplayAlerts = False Set Wf = ThisWorkbook fic = Dir(rep & "*.xls") ' recherche fichiers While fic <> "" If fic <> ThisWorkbook.Name Then chemin = rep & fic ' chemin fichiers Workbooks.Open chemin, 0 ' ouverture Set source = ActiveWorkbook.Sheets(1).Range("A1:IV65000") Wf.Sheets.Add source.Copy With Wf.Sheets(1) .Cells(1).PasteSpecial Paste:=8 .Cells(1).PasteSpecial Paste:=xlPasteValues .Cells(1).PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False End With ActiveWorkbook.Close End If fic = Dir Wend End Sub Il faut : _créer un classeur dans le dossier où se situent tous tes classeurs à regrouper _l'appeler comme bon te semble _l'ouvrir et appuyer sur Alt+F11 (l'éditeur VBA s'ouvre) _dans ThisWorkbook (par exemple), colle la macro ci-dessus, et exécute la en appuyant sur F5. Chez moi ça fonctionne :-) ------------------- Cordialement, Clément