List Hyperlinks Information.vb

Sub List_Hyperlinks()
    
    Dim ws As Worksheet, wsOutput As Worksheet
    Dim hlink As Hyperlink
    Dim row_insert As Long
    
    row_insert = 2
    
    Set wsOutput = ThisWorkbook.Worksheets.Add
    
    wsOutput.Range("A1").Resize(1, 3).Value = Array("Display Text", "Address", "Sub Address")
    
    For Each ws In ThisWorkbook.Worksheets
    
        For Each hlink In ws.Hyperlinks
            
            With wsOutput
                .Cells(row_insert, "A").Value = hlink.TextToDisplay
                .Cells(row_insert, "B").Value = hlink.Address
                .Cells(row_insert, "C").Value = hlink.SubAddress
            End With
                   
            row_insert = row_insert + 1
            
        Next hlink
        
    Next ws
        
    wsOutput.Cells.EntireColumn.AutoFit
    
    MsgBox "Complete."

    Set wsOutput = Nothing
    
End Sub