将来自不同工作簿的几个工作表（在1个文件中）合并到包含1个工作表“ sheets1”的工作簿中

Question

该想法是将工作簿中位于文件“ Filepath”中的所有工作表1合并到工作簿“工作表摘要”中 所有文件具有相同的标题，因此无需复制过去的标题 例如：2个文件

我在这里键入的代码：

Sub collate_data()
Dim folderpath As String
Dim filepath As String
Dim filename As String
Dim final As String



folderpath = ThisWorkbook.Sheets("input").Cells(1, 2).Text
filepath = folderpath & "*xlsx*"
filename = Dir(filepath)
smer = ThisWorkbook.Sheets("input").Cells(3, 2).Text
Dim lastrow As Long
Dim lastcolumn As Long

Do While filename <> ""
final = ThisWorkbook.Sheets("input").Cells(6, 2).Text
 y = final & "Summary.xlsx"

Workbooks.Open (folderpath & filename)

lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlDown).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Select
Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close

Set x = Workbooks.Open(smer)
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste = Worksheets("sheet1").Range(Cells(erow, 1), Cells(erow, 1))


filename = Dir
Loop
Application.DisplayAlerts = True


End Sub

Answer 1

您的代码中存在一些缺陷。例如，当您分配lastrow时，将单元格放在最后一行（rows.count）中，然后将end（xlDown）放置在最后一行中。如果要获取第1列中最后使用的行，则应为end（xlUp）。lastcolumn也有同样的问题。

此外，我看不到每次迭代文件名将如何变化。如果要迭代目录中的文件列表，通常会执行以下操作：

Dim fs, f, files, curfile
Dim i As Integer

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(path-to-folder)
Set files = f.Files
i = 5

For Each curfile In files
   ... whatever you need to be done with every file ...
Next

此外，粘贴数据时，必须首先选择左上角，然后执行Activesheet.Paste。在这种情况下：

x.Worksheets("sheet1").Cells(erow, 1).Select
ActiveSheet.Paste

但是请记住，您要在实际粘贴之前关闭要粘贴的数据的源，并且还要在循环的每次迭代中打开目标文件（smer），这将导致错误。循环开始时，该目标文件应该已经打开。

希望这对您的工作有所帮助