【VBA】特定の文字を含む行を配列を使って高速にコピーする方法

Option Explicit
Sub CopyRowsContainingSpecificText()
    Dim ws As Worksheet, targetWs As Worksheet
    Dim lastRow As Long, i As Long, j As Long
    Dim sourceRange As Range, targetRange As Range
    Dim data() As Variant
    
    ' シートを指定
    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set targetWs = ThisWorkbook.Sheets("TargetSheet")
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' 最終行の取得
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' データ範囲を配列に読み込む
    data = ws.Range("A2:A" & lastRow)
    
    ' ターゲットシートの最終行取得
    j = targetWs.Cells(targetWs.Rows.Count, 1).End(xlUp).Row + 1
    
    ' データコピー処理
    For i = LBound(data) To UBound(data)
        If InStr(1, data(i, 1), "特定の文字") > 0 Then
            ws.Rows(i + 2).Copy Destination:=targetWs.Rows(j)
            j = j + 1
        End If
    Next i
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub