Fusionner plusieurs fichiers excel en un seul
adeza74
Messages postés
6
Statut
Membre
-
adeza74 Messages postés 6 Statut Membre -
adeza74 Messages postés 6 Statut Membre -
Bonjour,
Je souhaite fusionner via une macro 12 fichiers excel qui ont tous la même structure (même ligne d'entête en ligne 1 et même nombre de colonnes).
Ils sont dans un répertoire "fichiers source".
Le fichier fusionné, à créer, se trouvera dans le répertoire "fichier fusionné". Au même niveau que "fichiers source".
Plus précisement, j'aimerais que:
1. on copie la ligne d'entête en permière ligne du fichier fusionné (une seule fois)
2. on mette le nom du fichier source en dernière colonne, à chaque ligne
Merci pour votre aide!
Je souhaite fusionner via une macro 12 fichiers excel qui ont tous la même structure (même ligne d'entête en ligne 1 et même nombre de colonnes).
Ils sont dans un répertoire "fichiers source".
Le fichier fusionné, à créer, se trouvera dans le répertoire "fichier fusionné". Au même niveau que "fichiers source".
Plus précisement, j'aimerais que:
1. on copie la ligne d'entête en permière ligne du fichier fusionné (une seule fois)
2. on mette le nom du fichier source en dernière colonne, à chaque ligne
Merci pour votre aide!
A voir également:
- Fusionner plusieurs fichiers excel en un seul vba
- Liste déroulante excel - Guide
- Renommer plusieurs fichiers en même temps - Guide
- Fusionner plusieurs feuilles excel en une seule - Guide
- Formule moyenne excel plusieurs colonnes - Guide
- Comment réduire la taille d'un fichier - Guide
2 réponses
Autre possibilité, j'ai ce code qui marche très bien pour fusionner les fichiers mais je ne suis pas parvenu à le modifier pour que:
1. on copie la ligne d'entête en permière ligne du fichier fusionné (une seule fois)
2. on mette le nom du fichier source en dernière colonne, à chaque ligne
Voilà le code:
Sub CollecterDataDesClasseurs()
Dim wbci As Workbook, wbso As Workbook
Dim shac As Worksheet
Dim deli As Integer, li As Integer, lici As Long 'Avant lici As Integer
Dim rep As String, dosA As String, dosB As String
Dim nclb As String, nclc As String, coci As String
li = Cells(Rows.Count, 1).End(xlUp).Row + 1
rep = Range("repbas"): dosA = Range("claco"): dosB = Range("clafi")
Set shac = ActiveSheet
' récupérer et ouvrir le classeur de collecte
Application.ScreenUpdating = False
nclb = Dir(rep & "\" & dosA & "\*.*")
Set wbci = Workbooks.Open(rep & "\" & dosA & "\" & nclb)
lici = wbci.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
'adresse de la dernière colonne
coci = Split(Cells(1, wbci.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column).Address, "$")(1)
' pointer sur répertoire des classeurs à traiter CD....
nclc = Dir(rep & "\" & dosB & "\*.*")
Do While nclc <> ""
Set wbso = Workbooks.Open(rep & "\" & dosB & "\" & nclc)
With wbso.Sheets(1)
deli = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A2:" & coci & deli).Copy Destination:=wbci.Sheets(1).Range("A" & lici)
lici = lici + deli - 1
End With
shac.Cells(li, 1) = nclc
shac.Cells(li, 2) = deli - 1
li = li + 1
wbso.Close
nclc = Dir ' suivant
Loop
MsgBox "Data are copied in the workbook : " & wbci.Name & Chr(10) & "which is located here: " & dosA
wbci.Close SaveChanges:=True
Set wbso = Nothing: Set wbci = Nothing: Set shac = Nothing
Application.ScreenUpdating = True
End Sub
1. on copie la ligne d'entête en permière ligne du fichier fusionné (une seule fois)
2. on mette le nom du fichier source en dernière colonne, à chaque ligne
Voilà le code:
Sub CollecterDataDesClasseurs()
Dim wbci As Workbook, wbso As Workbook
Dim shac As Worksheet
Dim deli As Integer, li As Integer, lici As Long 'Avant lici As Integer
Dim rep As String, dosA As String, dosB As String
Dim nclb As String, nclc As String, coci As String
li = Cells(Rows.Count, 1).End(xlUp).Row + 1
rep = Range("repbas"): dosA = Range("claco"): dosB = Range("clafi")
Set shac = ActiveSheet
' récupérer et ouvrir le classeur de collecte
Application.ScreenUpdating = False
nclb = Dir(rep & "\" & dosA & "\*.*")
Set wbci = Workbooks.Open(rep & "\" & dosA & "\" & nclb)
lici = wbci.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
'adresse de la dernière colonne
coci = Split(Cells(1, wbci.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column).Address, "$")(1)
' pointer sur répertoire des classeurs à traiter CD....
nclc = Dir(rep & "\" & dosB & "\*.*")
Do While nclc <> ""
Set wbso = Workbooks.Open(rep & "\" & dosB & "\" & nclc)
With wbso.Sheets(1)
deli = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A2:" & coci & deli).Copy Destination:=wbci.Sheets(1).Range("A" & lici)
lici = lici + deli - 1
End With
shac.Cells(li, 1) = nclc
shac.Cells(li, 2) = deli - 1
li = li + 1
wbso.Close
nclc = Dir ' suivant
Loop
MsgBox "Data are copied in the workbook : " & wbci.Name & Chr(10) & "which is located here: " & dosA
wbci.Close SaveChanges:=True
Set wbso = Nothing: Set wbci = Nothing: Set shac = Nothing
Application.ScreenUpdating = True
End Sub
Bonjour,
Le code que vous presentez fait a priori la meme chose pour la partie recherche et copie
Et je ne sais pas si j'ai raison de les déclarer en Characteres en Integer ou...
code avec ecriture nom de fichier a chaque ligne de copie du fichier, "mon" code precedent copiait le nom a la fin de chaque copie
Le code que vous presentez fait a priori la meme chose pour la partie recherche et copie
Et je ne sais pas si j'ai raison de les déclarer en Characteres en Integer ou...
code avec ecriture nom de fichier a chaque ligne de copie du fichier, "mon" code precedent copiait le nom a la fin de chaque copie
Sub Fusion_Fichiers()
Dim WBD As Workbook
'
Dim Chemin_Fichier As String
Dim Fichier As String
Dim CLD As String
Dim Plage As String
Dim ColNF As String
'
Dim TAdr As Variant
Dim ColF As Variant
'
Dim Derl As Long
Dim NbF As Long
Dim PCV As Long
Dim Of7 As Long
Dim LM As Long
Application.ScreenUpdating = False
Set WBD = ThisWorkbook 'fichier destinataire
WBD.ActiveSheet.Cells.ClearContents 'efface contenu feuille active, a voir pour nom de feuille
Chemin_Fichier = ThisWorkbook.Path & "\"
Fichier = Dir(Chemin_Fichier & "*.xlsx") 'premier fichier si existe
If Fichier <> "" Then
NbF = 1
Do While Fichier <> ""
If NbF = 1 Then
CLD = "$A$1" 'cellules titre colonnes pour copie
Of7 = 1 'offset ligne de depart
LM = 1 'offset ligne de fin
Else
CLD = "$A$2" 'cellules sans titre pour copie
Of7 = 0
LM = 2
End If
Workbooks.Open Chemin_Fichier & Fichier 'ouverture fichier
With ActiveSheet
Plage = .UsedRange.Address
TAdr = Split(Plage, ":")
ColF = Split(TAdr(1), "$")
ColNF = Chr(Asc(ColF(1)) + 1) 'colonne pour nom de fichier
LF = CLng(ColF(2)) - LM 'nb ligne du fichier source
Derl = WBD.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row 'derniere cellule non vide colonne A
If Derl > 1 Then Derl = Derl + 1
.Range(CLD & ":" & TAdr(1)).Copy WBD.ActiveSheet.Range("A" & Derl)
For n = Derl + Of7 To Derl + LF
WBD.ActiveSheet.Range(ColNF & n) = Fichier ' ecriture nom du fichier
Next n
End With
Workbooks(Fichier).Close False 'fermeture fichier source sans sauvegarde
Fichier = Dir 'fichier suivant si existe
NbF = NbF + 1 '
Loop
Else
MsgBox "Aucun Fichier trouve!!", vbCritical, "Annulation"
End If
Application.ScreenUpdating = True
End Sub
Bonjour,
Code sans boucle pour nom de fichier
Code sans boucle pour nom de fichier
Sub Fusion_Fichiers()
Dim WBD As Workbook
'
Dim Chemin_Fichier As String
Dim Fichier As String
Dim CLD As String
Dim Plage As String
Dim ColNF As String
'
Dim TAdr As Variant
Dim ColF As Variant
'
Dim Derl As Long
Dim NbF As Long
Dim PCV As Long
Dim Of7 As Long
Dim LM As Long
Application.ScreenUpdating = False
Set WBD = ThisWorkbook 'fichier destinataire
WBD.ActiveSheet.Cells.ClearContents 'efface contenu feuille active, a voir pour nom de feuille
Chemin_Fichier = ThisWorkbook.Path & "\"
Fichier = Dir(Chemin_Fichier & "*.xlsx") 'premier fichier si existe
If Fichier <> "" Then
NbF = 1
Do While Fichier <> ""
If NbF = 1 Then
CLD = "$A$1" 'cellules titre colonnes pour copie
Of7 = 1 'offset ligne de depart
LM = 1 'offset ligne de fin
Else
CLD = "$A$2" 'cellules sans titre pour copie
Of7 = 0
LM = 2
End If
Workbooks.Open Chemin_Fichier & Fichier 'ouverture fichier
With ActiveSheet
Plage = .UsedRange.Address
TAdr = Split(Plage, ":")
ColF = Split(TAdr(1), "$")
ColNF = Chr(Asc(ColF(1)) + 1) 'colonne pour nom de fichier
LF = CLng(ColF(2)) - LM 'nb ligne du fichier source
Derl = WBD.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row 'derniere cellule non vide colonne A
If Derl > 1 Then Derl = Derl + 1
.Range(CLD & ":" & TAdr(1)).Copy WBD.ActiveSheet.Range("A" & Derl)
WBD.ActiveSheet.Range(ColNF & Derl + Of7 & ":" & ColNF & Derl + LF) = Fichier ' ecriture nom du fichier
End With
Workbooks(Fichier).Close False 'fermeture fichier source sans sauvegarde
Fichier = Dir 'fichier suivant si existe
NbF = NbF + 1 '
Loop
Else
MsgBox "Aucun Fichier trouve!!", vbCritical, "Annulation"
End If
Application.ScreenUpdating = True
End Sub
Oui tant que le nom du fichier est recopié à chaque ligne.
Merci.
Vous connaisez le VBA Excel ou pas ??
un exemple de code:
Sub Fusion_Fichiers() Dim WBD As Workbook Application.ScreenUpdating = False Set WBD = ThisWorkbook 'fichier destinataire WBD.ActiveSheet.Cells.ClearContents 'efface contenu feuille active, a voir pour nom de feuille Chemin_Fichier = ThisWorkbook.Path & "\" Fichier = Dir(Chemin_Fichier & "*.xlsx") 'premier fichier si existe If Fichier <> "" Then NbF = 1 Do While Fichier <> "" If NbF = 1 Then CLD = "$A$1" 'cellules titre colonnes pour copie Else CLD = "$A$2" 'cellules sans titre pour copie End If Workbooks.Open Chemin_Fichier & Fichier 'ouverture fichier With ActiveSheet Plage = .UsedRange.Address TAdr = Split(Plage, ":") Derl = WBD.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row 'derniere cellule non vide colonne A If Derl > 1 Then Derl = Derl + 1 .Range(CLD & ":" & TAdr(1)).Copy WBD.ActiveSheet.Range("A" & Derl) With WBD.ActiveSheet PCV = .Range("A" & Rows.Count).End(xlUp).Row + 1 'premiere cellule vide colonne A .Range("A" & PCV) = Fichier 'ecriture nom de fichier End With End With Workbooks(Fichier).Close False 'fermeture fichier source sans sauvegarde Fichier = Dir 'fichier suivant si existe NbF = NbF + 1 ' Loop Else MsgBox "Aucun Fichier trouve!!", vbCritical, "Annulation" End If Application.ScreenUpdating = True End SubJe connais un peu VBA mais là je suis bloqué avec un message d'erreur au niveau de chaque variable qui n'a pas été déclarée.
Et je ne sais pas si j'ai raison de les déclarer en Characteres en Integer ou...