Excel : Fusionner plusieurs fichier XLS Résolu

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

Excel : Fusionner plusieurs fichier XLS

5 réponses

Newsletters