100 excel bestanden samenvoegen in 1 werkmap

[wieckbud]

Goedemorgen, ik heb meer dan 100 excel bestanden met dezelfde indeling.
Nu wil ik deze samenvoegen naar 1 bestand met 1 tabblad. Ik heb al ergens een macro gevonden om het samen te voegen maar hierbij maakt hij voor elk bestand een aparte tabblad aan.
Ik zou dus als eindresultaat 1 lange lijst willen hebben.

 

[SjonR]

plaats eens wat je al hebt dan.

 

[Timshel]

Kijk eens of je dit kan omwerken.
https://www.helpmij.nl/forum/showthread.php/893121-Bestanden-samenvoegen

 

[emields]

da's wel heel weinig info als je wilt geholpen worden. Staan die bestanden allemaal in dezelfde map?

 

[DANIEL162]

Zo iets:

Dim bookList As Workbook
Dim dirObj As Object, filesObj As Object, everyObj As Object
Dim y As Long, x As Long, z As Long
Application.ScreenUpdating = False
Set dirObj = CreateObject("Scripting.FileSystemObject").Getfolder("C:\users\hsv\desktop\Testmap")  'aanpassen
Set filesObj = dirObj.Files
  For Each everyObj In filesObj
             y = y + 1
    If y Mod 4 = 1 Then x = x + 1
  Set bookList = Workbooks.Open(everyObj)
  ThisWorkbook.Sheets(x).Cells(3, 1).Offset(, z).Resize(ActiveWorkbook.Sheets(1).Cells(1).CurrentRegion.Rows.Count, 5) = ActiveWorkbook.Sheets(1).Cells(1).CurrentRegion.Offset(1).Value
             z = IIf(z = 18, 0, z + 6)
  bookList.Close
 Next

 

[wieckbud]

heb een voorbeeldbestand gemaakt, hoe zet ik die bij het bericht?

 

[wieckbud]

volgens mij zo
Bestanden staan allemaal in dezelfde map en hebben dezelfde indeling

 

[snb]

Zijn het oorspronkelijk geen csv/txt bestanden ?

 

[wieckbud]

Zijn het oorspronkelijk geen csv/txt bestanden ?

klopt, heb ze allemaal omgezet naar excel, maakt dat nog uit?

 

[VenA]

Dat maakt zeker uit. Met een simpele DOS opdracht kan je al die bestanden samenvoegen tot 1 bestand. Dan hoef je nog maar 1 bestand om te zetten naar excel.

Vanuit de juiste map : Copy *.csv temp.csv

 

[wieckbud]

Dat maakt zeker uit. Met een simpele DOS opdracht kan je al die bestanden samenvoegen tot 1 bestand. Dan hoef je nog maar 1 bestand om te zetten naar excel.

Vanuit de juiste map : Copy *.csv temp.csv

Die csv bestanden kan ik niet meer gebruiken, zijn niet meer up to date. Moet dus echt alle excel bestanden samenvoegen

 

[VenA]

Daar zijn al twee suggesties voor gedaan.

 

[wieckbud]

Zo iets:

Dim bookList As Workbook
Dim dirObj As Object, filesObj As Object, everyObj As Object
Dim y As Long, x As Long, z As Long
Application.ScreenUpdating = False
Set dirObj = CreateObject("Scripting.FileSystemObject").Getfolder("C:\users\hsv\desktop\Testmap")  'aanpassen
Set filesObj = dirObj.Files
  For Each everyObj In filesObj
             y = y + 1
    If y Mod 4 = 1 Then x = x + 1
  Set bookList = Workbooks.Open(everyObj)
  ThisWorkbook.Sheets(x).Cells(3, 1).Offset(, z).Resize(ActiveWorkbook.Sheets(1).Cells(1).CurrentRegion.Rows.Count, 5) = ActiveWorkbook.Sheets(1).Cells(1).CurrentRegion.Offset(1).Value
             z = IIf(z = 18, 0, z + 6)
  bookList.Close
 Next

Heb nu onderstaande gedaan, hij zet ze nu wel bij elkaar maar naast elkaar en niet onder elkaar

Sub VoegSamen()
Dim bookList As Workbook
Dim dirObj As Object, filesObj As Object, everyObj As Object
Dim y As Long, x As Long, z As Long
Application.ScreenUpdating = False
Set dirObj = CreateObject("Scripting.FileSystemObject").Getfolder("C:\Users\Wieckbud\Desktop\Looplijsten 2") 'aanpassen
Set filesObj = dirObj.Files
For Each everyObj In filesObj
y = y + 1
If y Mod 4 = 1 Then x = x + 1
Set bookList = Workbooks.Open(everyObj)
ThisWorkbook.Sheets(x).Cells(3, 1).Offset(, z).Resize(ActiveWorkbook.Sheets(1).Cells(1).CurrentRegion.Rows.Count, 5) = ActiveWorkbook.Sheets(1).Cells(1).CurrentRegion.Offset(1).Value
z = IIf(z = 18, 0, z + 6)
bookList.Close
Next
End Sub

 

[VenA]

Je moet ook de code uit #3 gebruiken.

Sub VoegSamen()
  For Each Br In Split(CreateObject("Wscript.Shell").Exec("cmd /c dir ""[COLOR="#FF0000"]C:\Users\Wieckbud\Desktop\Looplijsten 2\[/COLOR]*.xls[COLOR="#FF0000"]x[/COLOR]"" /b/s").StdOut.ReadAll, vbCrLf)
     With GetObject(Br)
       with  .Sheets(1).Cells(1).CurrentRegion.Offset(1)
        ThisWorkbook.Sheets("[COLOR="#FF0000"]Blad1[/COLOR]").Cells(Rows.Count, 1).End(xlUp).Offset(1).resize(.rows.count,.columns.count)=.Value
       end with
       .Close 0
     End With
  Next
End Sub

 

[wieckbud]

Ik geef het maar op, nu stopt hij weer na een bestand of 20 helaas. Hij zet het wel onder elkaar.

 

[roeljongman]

Misschien heb je ook wat aan dit artikel uit CM web over samenvoegen van excelbestanden met dezelfde layout met behulp van Powerquery
https://cmweb.nl/2018/09/consolidere...cel-bestanden/

is een andere benadering dan VBA, wellicht eenvoudiger?