Question

我写了一个可以工作的宏，但是鉴于大量数据，这需要很多时间。我想知道是否有加快速度的方法。这是它的摘要：

在“摘要（全部）”选项卡中，我具有包含所有数据的全局工作表。
我有几个对应于每个月的标签。

我希望基于一列中的值将数据分发到这些选项卡（应与选项卡名称匹配）。

Option Explicit   
Sub CopyDataOutToSheets()



Dim sh As Worksheet
Dim SourceSh As Worksheet
Dim Last As Long
Dim shLast As Long
Dim CopyRng As Range
Dim StartRow As Long
Dim lrow As Long
Dim r As Long

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

Set SourceSh = ActiveWorkbook.Worksheets("Summary (All)")



Application.DisplayAlerts = False
On Error Resume Next
On Error GoTo 0


For Each sh In ActiveWorkbook.Worksheets

If IsError(Application.Match(sh.Name, _
                             Array(SourceSh.Name, "List Data", "Lists", "Summary (Filtered)"), 0)) Then

lrow = lastRow(sh)


If lrow > 6 Then

    sh.Rows("7:" & lrow).Delete
End If


If lastRow(SourceSh) < 7 Then
MsgBox ("Nothing to move")
Exit Sub
End If


For r = lastRow(SourceSh) To 7 Step -1

    'Finding the first empty row in column A on destination worksheet
    If SourceSh.Range("N" & r).Value = sh.Name Then
    SourceSh.Rows(r).Copy Destination:=sh.Range("A" & lastRow(sh) + 1)
    End If

Next r



End If


Next



ExitTheSub:

Application.Goto SourceSh.Cells(1)




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



End Sub

全局选项卡中有几千行，因此我希望分发后每个选项卡中大约有1000行。您能否让我知道使它更快发生的最佳方法是什么？

宏，用于根据标签名称

0 个答案: