Fusionner plusieurs fichier excel en un unique

[m0nnex]

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]

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

 

[Lone-wolf]

Re

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

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