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

Option Explicit
Sub TransferRowsContainingSpecificText()
    Dim ws As Worksheet, targetWs As Worksheet
    Dim lastRow As Long, i As Long, j As Long
    Dim sourceData() As Variant, targetData() As Variant
    
    ' シートの設定
    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set targetWs = ThisWorkbook.Sheets("TargetSheet")
    
    ' 最終行を取得
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    ' データの読み込み（配列に格納）
    sourceData = ws.Range("A1:A" & lastRow)
    ReDim targetData(0 To UBound(sourceData)) As Variant
    j = 0
    
    ' 配列から特定の文字を含む行を抽出
    Application.ScreenUpdating = False
    For i = LBound(sourceData) To UBound(sourceData)
        If InStr(1, sourceData(i, 1), "特定の文字", vbTextCompare) > 0 Then
            targetData(j) = sourceData(i, 1)
            j = j + 1
        End If
    Next i
    
    ' 抽出したデータをターゲットシートへ書き込み
    ReDim Preserve targetData(0 To j - 1)
    targetWs.Range("A1").Resize(j, 1).Value = Application.Transpose(targetData)
    
    ' メモリ解放と画面更新の再開
    Set ws = Nothing: Set targetWs = Nothing
    Erase sourceData: Erase targetData
    Application.ScreenUpdating = True
End Sub