VBA to copy data from one worksheet in multiple workbooks to a master, single sheet

[jdhfch]

Hi,

Please can anyone help me?

I have been using this code to copy all the data from 10 workbooks in a single location to a master, each dataset is added below the previous on a single sheet. It has worked fine, but I have now had to add another worksheet, which I don't need to copy to the master but now the code doesn't work. The only sheet from the source I want to copy the data from is called 2020.

This is the code that has worked until now:
Sub simpleXlsMerger()
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")

'change folder path of excel files here
Set dirObj = mergeObj.Getfolder("\\Documents\Databases\2020\Current Files")
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:AF" & 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
Next
End Sub

Private Sub Workbook_Open()

End Sub

Any help would be appreciated!

Rgds

J

 

[mumps]

Try:

Sub simpleXlsMerger()
    Application.ScreenUpdating = False
    Dim bookList As Workbook, mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object, desWS As Worksheet
    Set mergeObj = CreateObject("Scripting.FileSystemObject")
    Set dirObj = mergeObj.Getfolder("\\Documents\Databases\2020\Current Files")
    Set filesObj = dirObj.Files
    Set desWS = ThisWorkbook.Sheets(1)
    For Each everyObj In filesObj
        Set bookList = Workbooks.Open(everyObj)
        Sheets("2020").Range("A2:AF" & Sheets("2020").Range("A65536").End(xlUp).Row).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1)
        bookList.Close
    Next everyObj
    Application.ScreenUpdating = True
End Sub

 

[jdhfch]

Excellent, thank you

 

[mumps]

You are very welcome.