Hallo,
Ik ben geen expert en ben even bezig met onderstaande merge script, de bedoeling is dat vanuit verschillende bestanden gegevens van werkblad1 in het verzamelbestand op werkblad 1 komen en idem voor werkblad 2 uit de bestanden op werkblad2 van het verzamelbestand. Na het inlezen sluit het bestand waaruit de gegevens komen automatisch waarna het volgende bestand wordt geopend, en hetzelfde gebeurt. Het werkt wel maar ik krijg steeds de melding "fout 9 subscript valt buiten bereik", ik kan zo snel niet de oplossing vinden. Kan iemand mij helpen, ik hoop dat ik een beetje duidelijk ben
. Alvast superbedankt.
Ik ben geen expert en ben even bezig met onderstaande merge script, de bedoeling is dat vanuit verschillende bestanden gegevens van werkblad1 in het verzamelbestand op werkblad 1 komen en idem voor werkblad 2 uit de bestanden op werkblad2 van het verzamelbestand. Na het inlezen sluit het bestand waaruit de gegevens komen automatisch waarna het volgende bestand wordt geopend, en hetzelfde gebeurt. Het werkt wel maar ik krijg steeds de melding "fout 9 subscript valt buiten bereik", ik kan zo snel niet de oplossing vinden. Kan iemand mij helpen, ik hoop dat ik een beetje duidelijk ben
. Alvast superbedankt.
Code:
Sub simpleXlsMerger()
Cells.Select
Range("A2:AG1000").Select
Selection.ClearContents
Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
'Werkblad 1 opvragen
'change folder path of excel files here
Set dirObj = mergeObj.Getfolder("C:\Test\")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)
'change "A2" with cell reference of start point for every files here
'for example "B3:IV" to merge all files start from columns B and rows 3
'If you're files using more than IV column, change it to the latest column
'Also change "A" column on "A65536" to the same column as start point
Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate
'Do not change the following column. It's not the same column as above
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
bookList.Close savechanges:=False
Next
'Werkblad 2 opvragen
'change folder path of excel files here
Set dirObj = mergeObj.Getfolder("C:\Test\")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)
Worksheets(ActiveSheet.Index + 1).Select
'change "A2" with cell reference of start point for every files here
'for example "B3:IV" to merge all files start from columns B and rows 3
'If you're files using more than IV column, change it to the latest column
'Also change "A" column on "A65536" to the same column as start point
Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate
'Do not change the following column. It's not the same column as above
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
bookList.Close savechanges:=False
Next
End Sub
Laatst bewerkt:
