Sujet Précédent Sujet Suivant

Regrouper plusieurs fichiers excel en un seul

Fermé
Thib07 Messages postés 9 Date d'inscription jeudi 10 octobre 2013 Statut Membre Dernière intervention 29 avril 2014 - 5 févr. 2014 à 10:27
 Vanessa - 17 févr. 2014 à 16:36
Bonjour,
Je m'excuse d'avance si la question a déjà été posé mais je n'ai rien trouvé qui me satisfaisais.
J'aimerai regroupé plusieurs fichiers excel en seul.
Où chaque feuille du classeur correspond à un fichier.
J'espère me faire comprendre.
Merci d'avance pour vos réponse.


1 réponse

Réponse 1 / 1
Vanessa
17 févr. 2014 à 16:36
Bonjour,

Pour cela, il te suffit de rassembler dans un même répertoire les classeurs à regrouper, qui seront au format .xlsx (sinon modifier l'extension à l'endroit voulu dans le code), de créer un nouveau classeur au format .xlsm et d'y saisir le code suivant à exécuter: 

Sub Regroupement()
Dim wbbase As Workbook, shbase As Worksheet
Dim ext As String, chemin As String
Dim fs As Object, f As Object, sf As Object
Dim wbo As Variant
Dim deli As Long, deliba As Long
 Application.ScreenUpdating = False
Set wbbase = ActiveWorkbook
Set shbase = Sheets("Recap")
chemin = wbbase.Path
ext = "xlsx"
' Extension à adapter
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(chemin)
Set sf = f.Files
For Each wbo In sf  
    If wbo.Name <> wbbase.Name And Right(wbo.Name, Len(ext)) = ext Then
        Workbooks.Open (chemin & "\" & wbo.Name)
        Sheets(1).Copy after:=wbbase.Sheets(Sheets.Count)
        deli = shbase.Cells(Rows.Count, 1).End(xlUp).Row + 1
        shbase.Cells(deli, 1).Value = wbo.Name
        shbase.Cells(deli, 2).Value = Date & " à " & Time
        Workbooks(wbo.Name).Close SaveChanges:=True
    End If
Next wbo
Set f = Nothing: Set fs = Nothing: Set sf = Nothing
shbase.Activate
Set wbbase = Nothing: Set shbase = Nothing
Application.ScreenUpdating = True

MsgBox "Les fichiers sont regroupés dans ce classeur."

End Sub

En principe, un seul classeur sera créé regroupant chacun de tes fichier par onglet.

Cdlt.
0