Sub HLnk2FtNt()
Application.ScreenUpdating = False
Dim h As Long, Rng As Range
With ActiveDocument
  For h = .Hyperlinks.Count To 1 Step -1
    With .Hyperlinks(h)
         Set Rng = .Range
         With Rng
              .Collapse wdCollapseEnd
              .Footnotes.Add Rng
              .End = .End + 1
         End With
         bmName = .SubAddress
         Set hlRng = ActiveDocument.Bookmarks(bmName).Range
         ActiveDocument.Hyperlinks(h).Delete
         With hlRng
              .Expand wdParagraph
              .Start = .Start + 2
              .End = .End - 1
         End With
         Rng.Footnotes(1).Range.FormattedText = hlRng.FormattedText
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub