vba - 将来自不同工作簿(在 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) 的循环的每次迭代，这将导致错误。循环开始时，该目标文件应该已经打开。

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