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
Vanessa - 17 févr. 2014 à 16:36
A voir également:
- Regrouper plusieurs fichiers excel en un seul
- Liste déroulante excel - Guide
- Regrouper plusieurs pdf en un seul - Guide
- Regrouper plusieurs feuilles excel en une seule - Guide
- Renommer plusieurs fichiers en même temps - Guide
- Wetransfer gratuit fichiers lourd - Guide
1 réponse
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:
En principe, un seul classeur sera créé regroupant chacun de tes fichier par onglet.
Cdlt.
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.