Hi All,
I found this code online. For the most part it works to what I want it to do. But there are a couple of issues.
1 - I would like to add code where I can open a window to select where all the multiple files are located not just hardcoded.
2 - The line of code where I asking to Identify the name of the file where the data is coming from (Booklist name) places the name of the file in column O which is an empty column with the exception of the header. I would like the name to land in Column W after the last column in the Range (Column ). When the file has no data but the header the code works fine by placing the name of the file in column W.
3 - Last Issue, After the Macro is done running a pop up window appears Data Link Properties. It is listing the folder location as the data source. I have no idea why this keeps popping up. I just cancel because the data does tie correctly. I would like it to stop popping up.
I really appreciate some direction on this. I have a general knowledge of VBA but by no means an expert.
Thank you in Advance!
Sub MergeAllWorkbooks()
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")
' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
'change folder path of excel files here
Set dirObj = mergeObj.Getfolder("PASTE FOLDER PATH HERE")
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("A6:V" & 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
Range("A65536").End(xlUp).End(xlToRight).Offset(0, 1).Cells.Value = bookList.Name
Application.CutCopyMode = False
bookList.Close
Next
' Call AutoFit on the destination sheet so that all
' data is readable.
SummarySheet.Columns.AutoFit
End Sub
I found this code online. For the most part it works to what I want it to do. But there are a couple of issues.
1 - I would like to add code where I can open a window to select where all the multiple files are located not just hardcoded.
2 - The line of code where I asking to Identify the name of the file where the data is coming from (Booklist name) places the name of the file in column O which is an empty column with the exception of the header. I would like the name to land in Column W after the last column in the Range (Column ). When the file has no data but the header the code works fine by placing the name of the file in column W.
3 - Last Issue, After the Macro is done running a pop up window appears Data Link Properties. It is listing the folder location as the data source. I have no idea why this keeps popping up. I just cancel because the data does tie correctly. I would like it to stop popping up.
I really appreciate some direction on this. I have a general knowledge of VBA but by no means an expert.
Thank you in Advance!
Sub MergeAllWorkbooks()
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")
' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
'change folder path of excel files here
Set dirObj = mergeObj.Getfolder("PASTE FOLDER PATH HERE")
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("A6:V" & 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
Range("A65536").End(xlUp).End(xlToRight).Offset(0, 1).Cells.Value = bookList.Name
Application.CutCopyMode = False
bookList.Close
Next
' Call AutoFit on the destination sheet so that all
' data is readable.
SummarySheet.Columns.AutoFit
End Sub
