【VBA】特定の文字を含む行をエラー処理付きで別ブックとして保存する方法

Option Explicit
Sub ExtractRowsWithSpecificText()
    Dim ws As Worksheet, newWs As Worksheet
    Dim lastRow As Long, i As Long
    Dim searchText As String
    
    ' シートと検索文字列の設定
    Set ws = ThisWorkbook.Sheets("Sheet1")
    searchText = "特定の文字"
    
    Application.ScreenUpdating = False
    On Error GoTo ErrorHandler
    
    ' 新しいワークブックを作成し、シートを追加する
    Workbooks.Add
    Set newWs = ActiveWorkbook.Sheets(1)
    
    ' ヘッダー行のコピー
    ws.Rows("1:1").Copy Destination:=newWs.Rows("1:1")
    
    ' 最終行を取得する
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 特定の文字列を持つ行だけコピー
    For i = 2 To lastRow
        If InStr(1, ws.Cells(i, 1), searchText) > 0 Then
            ws.Rows(i).Copy Destination:=newWs.Rows(newWs.Rows.Count + 1)
        End If
    Next i
    
    ' 新しいワークブックを保存する
    newWs.Parent.SaveAs ThisWorkbook.Path & "\抽出データ.xlsx"
    MsgBox "処理が完了しました。", vbInformation
    Application.ScreenUpdating = True
    Exit Sub
ErrorHandler:
    MsgBox Err.Description, vbExclamation
    Application.DisplayAlerts = False
    ActiveWorkbook.Close SaveChanges:=False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub