【VBA】ハイパーリンクをエラー処理付きで別ブックとして保存する方法

Option Explicit
Sub SaveHyperlinksToNewWorkbook()
    Dim wb As Workbook, newWb As Workbook
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    
    ' エラー処理を有効にする
    On Error GoTo ErrorHandler
    
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet1")
    
    ' 最終行の取得
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 新しいワークブックを作成
    Set newWb = Workbooks.Add
    
    ' データコピー
    For i = 1 To lastRow
        If Not IsEmpty(ws.Cells(i, 1)) Then
            With ws.Hyperlinks(i - 1)
                newWb.Sheets(1).Cells(i, 1) = .Address
                newWb.Sheets(1).Hyperlinks.Add Anchor:=newWb.Sheets(1).Cells(i, 1), Address:=.Address, TextToDisplay:=ws.Cells(i, 2)
            End With
        End If
    Next i
    
    ' 新しいワークブックを保存
    newWb.SaveAs "C:\path\to\your\file.xlsx"
    
    MsgBox "データのコピーが完了しました。", vbInformation
    Exit Sub
ErrorHandler:
    MsgBox Err.Description, vbExclamation
End Sub