Excel VBA在合并母版纸时设置范围/打印区域

我有一个VBA代码，用于将不同的选项卡合并到一张工作表中。现在的问题是，将每个行项目复制到一张工作表中需要花费太长时间。需要更新，以便我可以将打印区域设置为范围，并将图纸复制回范围

 ActiveWorkbook.Worksheets("Master Sheet").Activate
    Rows("2:" & Rows.Count).Cells.ClearContents

    totalsheets = Worksheets.Count
    For i = 1 To totalsheets

    If Worksheets(i).Name <> "Master Sheet"  Then
    lastrow = Worksheets(i).Cells(Rows.Count, 1).End(xlUp).Row


            For j = 2 To lastrow

            Worksheets(i).Activate
            Worksheets(i).AutoFilterMode = False
            Worksheets(i).Rows(j).Select
            Selection.Copy
            Worksheets("Master Sheet").Activate                               

            lastrow = Worksheets("Master Sheet").Cells(Rows.Count, 1).End(xlUp).Row

            Worksheets("Master Sheet").Cells(lastrow + 1, 1).Select
            ActiveSheet.Paste
            Application.CutCopyMode = False

            Next
            End If
            Next
            MsgBox "Completed"
            ActiveWorkbook.Save
End Sub

ActiveWorkbook.工作表（“主工作表”）.激活
行（“2:&Rows.Count）.Cells.ClearContents
totalsheets=工作表。计数
对于i=1到总张数
如果是工作表（i），则命名为“主工作表”
lastrow=工作表（i）.单元格（Rows.Count，1）.结束（xlUp）.行
对于j=2到最后一行
工作表（i）.激活
工作表（i）.自动筛选模式=错误
工作表（i）.行（j）.选择
选择，复制
工作表（“主图纸”）。激活
lastrow=工作表（“主工作表”）。单元格（Rows.Count，1）。结束（xlUp）。行
工作表（“主工作表”）。单元格（lastrow+1，1）。选择
活动表。粘贴
Application.CutCopyMode=False
下一个
如果结束
下一个
MsgBox“已完成”
活动工作簿。保存
端接头

首先，避免选择工作表和单元格：

工作表（i）。激活

，

行（j）。选择

。这是最耗时的。通常可以用直接链接代替

接下来，不要在

j

的循环中重复

工作表（i）。对于j=2到最后一行，在
之前重复一次就足够了

第三，不要逐行复制。而是复制整个图纸：

Dim lastCell As Range
Set lastCell = Sheets("Sheet1").Range("A1").SpecialCells(xlLastCell)
Sheets("Sheet1").Range(Range("A1"), lastCell).Copy

请试试这个密码。它速度快，主要在内存中工作，使用阵列：

    Sub testConsolidate()
       Dim sh As Worksheet, shM As Worksheet, lastRowM As Long, arrUR As Variant

        Set shM = ActiveWorkbook.Worksheets("Master Sheet")
        shM.Rows("2:" & Rows.Count).Cells.Clear

        For Each sh In ActiveWorkbook.Worksheets
            If sh.Name <> "Master Sheet" Then
                sh.AutoFilterMode = False
                lastRowM = shM.Cells(Cells.Rows.Count, 1).End(xlUp).row
                arrUR = sh.UsedRange.Offset(1).value 'copy from row 2 down
                shM.Cells(lastRowM + 1, 1).Resize(UBound(arrUR, 1), _
                                            UBound(arrUR, 2)).value = arrUR
            End If
        Next
        MsgBox "Completed"
        ActiveWorkbook.Save
    End Sub

子测试整合（）
调暗sh作为工作表，shM作为工作表，lastRowM作为长，arrUR作为变量
设置shM=ActiveWorkbook.工作表（“主工作表”）
shM.Rows（“2:&Rows.Count）.Cells.Clear
对于ActiveWorkbook.工作表中的每个sh
如果上海名称为“母版图纸”，则
sh.AutoFilterMode=False
lastRowM=shM.Cells（Cells.Rows.Count，1）.End（xlUp）.row
arrUR=sh.UsedRange.Offset（1）。值“从第2行向下复制”
shM.单元格（lastRowM+1,1）。调整大小（UBound（arrUR，1）_
UBound（arrUR，2））。值=arrUR
如果结束
下一个
MsgBox“已完成”
活动工作簿。保存
端接头
行项目并不总是相同的，因此如何设置一次复制所有项目？通过设定范围？你能给我提供一些信息来源吗？请不要在评论中添加信息