Sub myHyperText()
    'アクティブシート上に設定済みのハイパーリンク先を
    '新規シートに書き出す　2003/10/05 pPoy
    Dim cnt As Long, i As Long
    Dim h As Variant
    Dim myData As Variant
    Dim myRange As Range
    
    With ActiveSheet
        cnt = .Hyperlinks.Count　　 'ハイパーリンクの個数
        If cnt = 0 Then Exit Sub
        ReDim myData(cnt, 0)　　　　'配列のサイズ設定
        i = 0
        For Each h In .Hyperlinks
            'アドレスを変数に格納
            myData(i, 0) = h.Address
            i = i + 1
        Next
    End With
    
    Worksheets.Add　　　　'新規シート追加
    Set myRange = ActiveSheet.Range("a1")
    myRange.Resize(cnt, 1).Value = myData
    Set myRange = Nothing

• Excel の行数を超える (65,536件超) ハイパーリンクがあった場合、エラーで止まります。
  
  
• 対象となるシートにハイパーリンクが１件も無かった場合は、何も起こりません。
  
  
• セル番地や表示名も必要な場合は、こちら をご覧ください。