Question

我现在非常感谢你的帮助。

我尝试从多个工作簿的F37:F53中获取一系列单元格Sheet1，然后将其粘贴到新工作簿的Sheet1中。我遇到的一个问题是所有数据都粘贴在一列中。我真正想要的是将每组数据粘贴到右侧的列。换句话说，工作簿1的F37:F53应该粘贴到最终工作簿的A1中。然后，应将F37:F53工作簿2粘贴到最终工作簿的B1中。依此类推，限制为365列

我非常感谢一些帮助，因为我对VBA还不熟悉

提前谢谢！

以下是我目前的情况：

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

假设FSO位正确，请尝试此

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

如果这只是你需要的东西，我建议使用RDBMerge。用于合并工作簿/工作表的绝佳工具。 RDBMerge

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

2 个答案: