将多个工作簿中的工作表复制到一个工作簿中并粘贴到右侧

Question

I would really appreciate some help right now.

I am trying to take a range of cells F37:F53 from Sheet1 of multiple workbooks and paste it into Sheet1 of a new workbook. The one issue I am having is that all the data pastes down in one column. What I actually want is each set of data to paste to the column to the right. So in other words F37:F53 of workbook 1 should be pasted into A1 of the final workbook. Then F37:F53 of workbook 2 should be pasted into B1 of the final workbook. So on and so forth with a limit of 365 columns

I would really appreciate some help as I am fairly new to VBA

Thank you in advance!

Here is what I have so far:

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")

Set dirObj = mergeObj.Getfolder("C:\Users\a0086850\Documents\421\2017")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)

Range("F37:F53" & Range("F65536").End(xlUp).Row).Copy
ThisWorkbook.Worksheets("2017").Activate

Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
bookList.Close
Next
End Sub

Answer 1

Assuming the FSO bit is right, try this

Sub simpleXlsMerger()

Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Dim c As Long

Application.ScreenUpdating = False

Set mergeObj = CreateObject("Scripting.FileSystemObject")
Set dirObj = mergeObj.Getfolder("C:\Users\a0086850\Documents\421\2017")
Set filesObj = dirObj.Files

For Each everyObj In filesObj
    Set bookList = Workbooks.Open(everyObj)
    c = c + 1
    bookList.Sheets(1).Range("F37:F53").Copy ThisWorkbook.Worksheets("2017").Cells(1, c)
    bookList.Close
Next

End Sub

Answer 2

If this is just something you need quick I suggest RDBMerge. A fantastic tool for merging workbooks/worksheets. RDBMerge