【VBA】ハイパーリンクを配列を使って高速にコピーする方法

Option Explicit
Sub CopyHyperlinksUsingArray()
    Dim ws As Worksheet, targetWs As Worksheet
    Dim lastRow As Long, i As Long
    Dim hyperLinks() As Variant

    ' シートを指定
    Set ws = ThisWorkbook.Sheets("SourceSheet")
    Set targetWs = ThisWorkbook.Sheets("TargetSheet")

    ' 最終行の取得
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    ' ハイパーリンク情報を配列に格納
    ReDim hyperLinks(1 To lastRow)
    For i = 1 To lastRow
        If Not IsEmpty(ws.Hyperlinks(i)) Then
            hyperLinks(i) = ws.Hyperlinks(i).Address & "|" & ws.Hyperlinks(i).SubAddress
        Else
            hyperLinks(i) = vbNullString
        End If
    Next i

    ' 画面更新を停止
    Application.ScreenUpdating = False

    ' ハイパーリンク情報をターゲットシートにコピー
    For i = 1 To lastRow
        If hyperLinks(i) <> vbNullString Then
            targetWs.Hyperlinks.Add Anchor:=targetWs.Cells(i, 1), Address:=Split(hyperLinks(i), "|")(0), SubAddress:=Split(hyperLinks(i), "|")(1)
        End If
    Next i

    ' 画面更新を再開
    Application.ScreenUpdating = True
End Sub