【VBA】全てのシートを配列を使って高速にコピーする方法

Option Explicit
Sub CopyAllSheetsToArray()
    Dim ws As Worksheet, targetWs As Worksheet
    Dim lastRow As Long, i As Long, j As Long
    Dim arrData() As Variant
    Set targetWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    targetWs.Name = "コピー先"
    Application.ScreenUpdating = False
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> targetWs.Name Then
            lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
            ReDim arrData(1 To lastRow - ws.Rows(1).Row + 1, 1 To ws.UsedRange.Columns.Count)
            For i = ws.Rows(1).Row To lastRow
                j = i - ws.Rows(1).Row + 1
                For k = 1 To ws.UsedRange.Columns.Count
                    arrData(j, k) = ws.Cells(i, k).Value
                Next k
            Next i
            targetWs.Range("A" & (targetWs.Cells(targetWs.Rows.Count, 1).End(xlUp).Row + 1)).Resize(UBound(arrData), UBound(arrData, 2)).Value = arrData
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub