Копирование гиперссылки в ВБА

Public Sub HipInsert()
Dim tblData As Table
Dim i As Integer
 Set tblData = Selection.Tables.Item(1)
 
Selection.EndKey Unit:=wdStory
For i = 2 To tblData.Rows.Count
    ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:=tblData.Cell(i, 2).Range.Hyperlinks.Item(1).Address, SubAddress:="", ScreenTip:="", TextToDisplay:=Replace(tblData.Cell(i, 1).Range, Chr(13) & Chr(7), "")
    Selection.TypeParagraph
Next i
tblData.Cell(1, 1).Select
Selection.Collapse
Set tblData = Nothing
End Sub

Public Sub HipInsertTwoTables()
Dim tblData As Table, tblTarget As Table
Dim i As Integer
 Set tblData = ActiveDocument.Tables.Item(1)
Set tblTarget = ActiveDocument.Tables.Item(2)
tblTarget.Cell(1, 3).Range.Paragraphs.Item(tblTarget.Cell(1, 3).Range.Paragraphs.Count - 1).Range.Select
 Selection.Collapse wdCollapseEnd
For i = 2 To tblData.Rows.Count
    ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:=tblData.Cell(i, 2).Range.Hyperlinks.Item(1).Address, SubAddress:="", ScreenTip:="", TextToDisplay:=Replace(tblData.Cell(i, 1).Range, Chr(13) & Chr(7), "")
    Selection.TypeParagraph
Next i
tblData.Cell(1, 1).Select
Selection.Collapse
Set tblData = Nothing
Set tblTarget = Nothing
End Sub

Sub bb()
Dim s$, c As Cell
  With Selection.Tables(1)
    For Each c In .Columns(2).Cells
      If c.Range.Hyperlinks.Count Then
        s = c.Previous.Range.Text
        c.Range.Hyperlinks(1).TextToDisplay = Trim$(Left$(s, Len(s) - 2))
      End If
    Next
    .Columns(1).Delete
    .ConvertToText
  End With
End Sub