Fusionner plusieurs fichier excel en un unique

m0nnex

XLDnaute Nouveau
Bonjour,

J'ai pas mal de fichiers Excel que je voudrais fusionner en un seul dans differentes feuilles en gardant le meme non de feuille. Existe-t-il une option permetant la fusion de plusieurs fichiers Excel?

J'ai trouvé sur votre site le code VBA 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

Mais je n'arrive pas à le faire rouler car je ne sais pas quoi modifier pour adjuster à mes fichiers a joindre

Merci !!
 

Lone-wolf

XLDnaute Barbatruc
Bonjour m0nnex

Sans renseigner le DIR normal qu'il ne trouve rien, où veux-tu qu'il aille chercher les informations? Il faut modifier comme ceci, pas besoin de ChDir.

rep = ThisWorkbook.Path & "\"
nf = Dir(rep & "*.xls")

ActiveWorkbook est le classeur source.
Set classeurMaitre = ThisWorkbook - classeur de destination
 
Dernière édition:

Lone-wolf

XLDnaute Barbatruc
Re

Une macro de Patrice33740 que je viens d'adapter et que tu peux tester aussi

VB:
Sub Copie_Feuilles()
Dim fichier As String, Chemin As String
Dim cel As Range, rng As Range
Dim compteur As Integer, k As Long

    Chemin = ThisWorkbook.Path & "\"
    Set rng = ThisWorkbook.Worksheets(1).Range("A2:N2")    'À adapter aux nombres de colonnes
    rng.Resize(1000).ClearContents  'Adapter au nombre max de fichiers
    fichier = Dir(Chemin & "*.xls")
    Compteur = 1
    Application.ScreenUpdating = False
    Do While Len(fichier) > 0
        For k = 1 To Sheets.Count
        For Each cel In rng.Cells                                            
            cel.Formula = "='" & Chemin & "[" & fichier & "]Feuil" & k & "'!" & Split(cel.Address, "$")(1) & "2"
            cel.Value = cel.Value
        Next cel
            classeurMaitre.Sheets(classeurMaitre.Sheets.Count).Name = "Mapage" & compteur
            compteur = compteur + 1
        Next k
        Set rng = rng.Offset(1)
        fichier = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 898
Membres
101 834
dernier inscrit
Jeremy06510