是否有更快的方法执行此VBA宏？

我正在尝试将Excel中的多个工作表合并到一个工作表中。我使用合并工作表在同一工作簿中运行一组报告

• 需要合并的工作表数量各不相同-大约6到40个工作表。我通过在表格前加上“Src”来识别要合并的表格
• 同一工作簿中约有40个其他电子表格（从合并工作表和其他计算中生成的报告）
• 要合并的每个工作表的格式相同

我不熟悉宏，所以在互联网上找到了一些代码来自动整合，但当我有12张左右需要整合的工作表时，它运行得非常慢

无论如何，我都可以加速这个宏吗

Sub CopyDataWithoutHeaders()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

' Clear the consol worksheet except the top row with the headings
Set DestSh = ActiveWorkbook.Worksheets("All Data")
DestSh.Rows("5:" & Rows.Count).ClearContents


' Fill in the start row.ie the row in each of the source sheets that contain the data (do not include heading rows)
StartRow = 5

' Loop through all worksheets and copy the data to the
' summary worksheet if worksheet name starts with src.
For Each sh In ActiveWorkbook.Worksheets
    If LCase(Left(sh.Name, 3)) = "src" Then

        ' Find the last row with data on the summary
        ' and source worksheets.
        Last = LastRow(DestSh)
        shLast = LastRow(sh)

        ' If source worksheet is not empty and if the last
        ' row >= StartRow, copy the range.
        If shLast > 0 And shLast >= StartRow Then
            'Set the range that you want to copy
            Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))

           ' Test to see whether there are enough rows in the summary
           ' worksheet to copy all the data.
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
               MsgBox "There are not enough rows in the " & _
               "summary worksheet to place the data."
               GoTo ExitTheSub
            End If

            ' This statement copies values, and formats.
            CopyRng.Copy
            With DestSh.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With

        End If

    End If
Next


ExitTheSub:
Application.GoTo DestSh.Cells(1)

' AutoFit the column width in the summary sheet.
DestSh.Columns.AutoFit

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
                        After:=sh.Range("A1"), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
On Error GoTo 0
End Function


Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
                        After:=sh.Range("A1"), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
On Error GoTo 0
End Function

---

假设有一列从头到尾没有空行，请尝试将

LastRow（）

函数替换为

Function LastRow(sh As Worksheet)
Dim i as Long, R as Range

    i = 1
    Set R = sh.[A1]

    Do while R(i,1) <> ""    ' we asume column A (.. 1) here
        i = i+1
    Loop

    LastRow = i

End Function

函数LastRow（sh作为工作表）
变暗i为长，R为范围
i=1
设置R=sh[A1]
当R（i，1）“”时，我们在这里计算列A（…1）
i=i+1
环
LastRow=i
端函数

或者，您可以使用

.CurrentRegion

属性来避免同时计算行和列。

替换：

Last = LastRow(DestSh)
shLast = LastRow(sh)

与

您有一个

LastCol（sh）

函数，但实际上我没有看到对它的调用。如果我丢失了它，您可以用以下内容替换函数调用：

sh.UsedRange.Columns.Count

通常情况下，粘贴会同时复制值和格式，因此，除非您试图避免某些特殊情况，否则请替换：

With DestSh.Cells(Last + 1, "A")
  .PasteSpecial xlPasteValues
  .PasteSpecial xlPasteFormats
  Application.CutCopyMode = False
End With

与

---

最后，请记住，VBA代码是在执行时进行解释的，并且固有地比预编译代码慢。而且，它仍然比手工操作快得多

您可以关闭计算和屏幕更新。尝试切断一些声明，如“StartRow”，因为它的值是固定的，它不是一个变量，所以只需将5放在它出现的位置，如果vlue没有随代码变化，就不需要为它创建变量，它不会变得更快，但它确实如此help@YgorYansz事实上在一个较长的过程中，使用常量或变量是有意义的，就像这样-如果值将来需要更新，那么您只需要在这一行中更改它一次，而不是查找每一行并替换该值。@因此我知道，我的意思是，在这种特殊情况下，因为它只出现两次，并且不会随代码而更改，因此，对于这种特殊情况，

Last=DestSh.UsedRange.Rows.Count

假设

UsedRange

从第1行开始，您应该对DestSh.UsedRange:Last=.Rows（.Rows.Count）使用类似于

的内容。row:End With

以获取所用范围内最后一行的实际行数。@这是真的，他的数据从

StartRow=5

开始，但他在使用

Last

和

shLast

时考虑到了这一点，所以在这种情况下，担心这一点是不相关的。当然，在没有看到实际数据的情况下，这一切都只是猜测，但我想我会提到这一点，以防其他人看到此页面并在不同的数据集上使用此答案。谢谢。我已经实现了所有这些建议，并且运行时间已减少到不到一分钟。

With DestSh.Cells(Last + 1, "A")
  .PasteSpecial xlPasteValues
  .PasteSpecial xlPasteFormats
  Application.CutCopyMode = False
End With

DestSh.Cells(Last + 1, "A").Paste
Application.CutCopyMode = False