Macro to distribute data within the sheets based on tabs name I wrote a macro which works, but given the large amount of data, it takes a lot of time. I wonder if there is a way to speed it up. Here is a summary of what it does:


In "Summary (All)" tab I have global sheet with all the data.
I have several tabs corresponding to the each months.
I want to have the data distributed to those tabs, based on the value in one column (should match the tab name). 


My code

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 &gt; 6 Then
                sh.Rows("7:" &amp; lrow).Delete
            End If

            If lastRow(SourceSh) &lt; 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" &amp; r).Value = sh.Name Then
                    SourceSh.Rows(r).Copy Destination:= _
                                                  sh.Range("A" &amp; 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


There are few thousands rows in global tab, so I'm expecting to have roughly 1000 in each tab after distribution. Could you please let me know what would be the best way to make it happen more quickly?
Use any method that make a "directly-interation" with worksheet like copy, paste, range.value = something (...) intensifies the runtime of the code. To solve this you need to create an array to store the SourceSh.Rows(r) values. Before the loop change spreadsheet you parse all values stored in the array to cells using the method that I will show in the example. When the loop change spreadsheet you clear the array.

With that I think that you will have at least 65% better performance.

I created an example comparing runtime of the array method with the single value method, 
to 20k cells. See the difference?

[

Sub Compare()

Dim arr() As Variant
Dim max As Long
Dim start As Double

start = Timer

max = 20000
ReDim arr(max)

Application.ScreenUpdating = False

'Using the array method

For i = 1 To max

    arr(i) = i

Next i

Sheets("Planilha1").Range("A1:A" &amp; UBound(arr) + 1) = WorksheetFunction.Transpose(arr)
Debug.Print "Array method in seconds: " &amp; Round(Timer - start, 2)


'Parsing single values method

start = Timer

For i = 1 To UBound(arr)

    Sheets("Planilha1").Range("A1:A" &amp; UBound(arr) + 1) = i

Next i

Debug.Print "Value method in seconds: " &amp; Round(Timer - start, 2)


Application.ScreenUpdating = True

End Sub