我有 5 个人,每个人都维护着自己的 Excel 文件。这些文件都有一个我关心的选项卡,它们具有相同的数据结构(列),每个选项卡有超过 20,000 行。我需要将该选项卡从每个工作表中拉入主工作表中,而不是他们可能有的任何其他选项卡。
为此,我创建了一个主工作簿,并为每个单独的工作簿添加了数据链接,并创建了一个选项卡,从单独的工作簿中提取我想要的数据。然后,我使用下面的 VBA 脚本创建一个主选项卡,该选项卡结合了我创建的选项卡中的所有数据。如果有必要,所有这些文件都作为文档托管在 SharePoint 中。
Sub Master()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Master"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub
我的问题有两个方面。
首先,有没有更好的方法可以降低开销?我们有 40 列和超过 100,000 行,因此工作表以蜗牛速度移动并定期锁定。(我们正在构建一个非 Excel 解决方案,但在完成之前我们需要它工作)
其次,我是否可以编辑上述脚本以 1. 继续更新已创建的工作表?以及 2. 排除工作表中的特定选项卡,例如名为reports
和 的选项卡dashboard
?
答案1
下面的代码将帮助您将特定工作表复制到 Mater 工作簿。
Sub CopySheets()
Dim sh as Worksheet, wb as Workbook
Set wb = Workbooks("Target Workbook")
For Each sh in Workbooks("Source Workbook").Worksheets(Array("sheet1","sheet2"))
sh.Copy After:=wb.Sheets(wb.sheets.count)
Next sh
End Sub
笔记:
- 您可以编辑此 VBA 代码以添加尽可能多的要复制的工作表(作为数组)
Worksheets(Array("sheet1","sheet2"))
。 如果你想要复制整个工作簿我可以建议你最快的方法是,
ThisWorkbook.saveas Filename:=NewFileNameWithPath, Format:=xlOpenXMLWorkbook