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

Question

想法是将位于文件“文件路径”中的工作簿中的所有工作表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)，这将导致错误。循环开始时，该目标文件应该已经打开。

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