Fusionner des classeurs slsx dans un seul

Messages : 125

Inscription : 06 avr. 2010 21:56

Profil de l'utilisateur : Élève de lycée

Fusionner des classeurs slsx dans un seul

Message par Mozart » 11 déc. 2017 16:18

Bonjour,
J'essaye de fusionner plusieurs classeurs xlsx dans un seul : les fichier se trouvent dans un dossier dont le chemin : F:\Conformité\Transferts\Abus de marché\VBA\
Les classeurs sont formés d'une seule feuille, tous aux même format.

Un code à proposer ?

J'ai tenté celui là que j'ai trouvé sur internet mais en gros il ne copie que le nom des differntes fichiers ...


Sub MergeAllWorkbooks()
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim NRow As Long
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range

' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

' Modify this folder path to point to the files you want to use.
FolderPath = "F:\Conformité\Transferts\Abus de marché\VBA\"

' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1

' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*.xlsx*")

' Loop until Dir returns an empty string.
Do While FileName <> ""
' Open a workbook in the folder
Set WorkBk = Workbooks.Open(FolderPath & FileName)

' Set the cell in column A to be the file name.
SummarySheet.Range("A" & NRow).Value = FileName

' Set the source range to be A9 through C9.
' Modify this range for your workbooks.
' It can span multiple rows.
Set SourceRange = WorkBk.Worksheets(1).Range("A9:C9")

' Set the destination range to start at column B and
' be the same size as the source range.
Set DestRange = SummarySheet.Range("B" & NRow)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
SourceRange.Columns.Count)

' Copy over the values from the source to the destination.
DestRange.Value = SourceRange.Value

' Increase NRow so that we know where to copy data next.
NRow = NRow + DestRange.Rows.Count
' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False

' Use Dir to get the next file name.
FileName = Dir()
Loop

' Call AutoFit on the destination sheet so that all
' data is readable.
SummarySheet.Columns.AutoFit
End Sub
pcsi ~~ Louis barthou

Messages : 9679

Inscription : 30 juil. 2008 16:59

Profil de l'utilisateur : Élève de lycée

Re: Fusionner des classeurs slsx dans un seul

Message par fakbill » 14 déc. 2017 10:18

On ne fait pas de bureautique sur ce site.
Définis proprement "fusionner". tu veux obtenir un seul fichier avec un onglet par fichier source?
je ferais ça en python avec le module qui va bien pour jouer avec les fichier excel. Google est ton ami.
Le VBA me provoque des remontées acides.
Pas prof.
Prépa, école, M2, thèse (optique/images) ->ingé dans le privé.

Répondre