Traspaso de hipervínculo a otro libro

hola a todos:
tengo la siguiente duda, tengo un formulario en excel en el cual ingreso hipervínculos diferentes y posteriormente los guardo, en un archivo al cual le asigno nombre (lo guardo con la función saveas), en el código anexe una explicación ojala se entienda la idea :D

Private Sub CREAR_LISTA2()
 Dim n As Integer
 Dim wbNuevoLibro As Workbook
 Dim nFilaSalida As Integer
 Dim sFileXLS$
 Dim ruta
 Dim NIVEL_ant As Integer 'nivel de jerarquía del ítem inmediato anterior
 Dim RAIZ_ant As String 'raíz o padre del ítem inmediato anterior
 Dim J As Integer 'variable contador
 '1. Comprobamos si hay algún elemento seleccionado en la lista
 If Not ElementosSeleccionados() Then
 MsgBox "Debes seleccionar algún elemento de la lista", vbInformation
 Exit Sub
 End If
 '2. Abrimos un nuevo libro de trabajo excel
 Set wbNuevoLibro = Workbooks.Add()
 nFilaSalida = 7
 wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 1) = "ITEM"
 wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 2) = "DESCRIPCION"
 wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 3) = "Lista B"
 wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 4) = "Estandar"
 wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 5) = "UNIDAD"
 wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 6) = "CANTIDAD."
 wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 7) = "PRECIO UNITARIO $"
 wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 8) = "PRECIO TOTAL $"
 Columns("B:B").ColumnWidth = 81.57
 Columns("D:D").ColumnWidth = 14.57
 Columns("E:E").ColumnWidth = 19.86
 Columns("F:F").ColumnWidth = 13.29
 Columns("G:G").ColumnWidth = 13.99
 Columns("H:H").ColumnWidth = 13.99
 nFilaSalida = nFilaSalida + 1
 'Fecha
 Range("F5").Select
 ActiveCell.FormulaR1C1 = "=TODAY()"
 Range("F5").Select
 Selection.NumberFormat = "[$-340A]d"" de ""mmmm"" de ""yyyy;@"
 Columns("F:F").ColumnWidth = 19.71
 'Insertamos un boton para imprimir
 Range("I7").Select
 ActiveSheet.Buttons.Add(1020.78, 123, 72, 40).Select
 Selection.Characters.Text = "Imprimir"
 Range("I7").Select
 '3. Recorremos la lista de elementos y pasamos los seleccionados al nuevo libro
 NIVEL_ant = -1
 RAIZ_ant = ""
 For n = 0 To LIS.ListCount - 1
 If LIS.Selected(n) = True Then
 'Re-enumerar los ítems, de modo que los de una misma jerarquía
 'se enumeren consecutivamente, a partir del 1.
 'Sólo aplica para objetos hijo, es decir, objetos con jerarquía mayor
 'que cero.
 If nFilaSalida > 7 Then
 If NIVEL(LIS.List(n, 0)) > 0 Then
 If raiz(LIS.List(n, 0)) = RAIZ_ant Then
 J = J + 1
 Else
 J = 1
 End If
 Else
 J = 0
 End If
 Else
 J = 0
 End If
 'esto es para evitar que los "puntos" se vuelvan "comas"
 With wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 1)
 .NumberFormat = "@"
 .HorizontalAlignment = xlRight
 If J = 0 Then
 .Value = CStr(LIS.List(n, 0))
 Else
 .Value = CStr(raiz(LIS.List(n, 0))) & "." & CStr(J)
 End If
 .Value = Replace(.Text, ",", ".")
 If NIVEL(LIS.List(n, 0)) = 0 Then
 'pone en negrilla los ítems de nivel jerárquico cero
 .Font.Bold = True
 .Offset(0, 1).Font.Bold = True
 End If
 End With
 wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 2) = LIS.List(n, 1) '"ITEM"
 wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 3) = LIS.List(n, 2) '"DESCRIPCION"
 wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 4) = LIS.List(n, 3) '"Lista B"
 wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 5) = LIS.List(n, 4) '"Estandar"
 'Aqui genero el traspado del hipervincuo hacia los otros libros lo malo es que se traspasa
solo el hipervinculo hacia este archivo "Estandar\5D-61.01.pdf", y yo tengo 5 hipervinculo 
diferentes y mi idea es que se pasen los hipervinculos que yo selecciono los cuales 
se encuentran en la carpeta "Estandar" ..., como puedo realizar esta operacion.....
 ' wbNuevoLibro.Worksheets(1).Hyperlinks.Add Anchor:=Cells(nFilaSalida, 5), Address:= _
 'ThisWorkbook.Path & "\Estandar\5D-61.01.pdf", TextToDisplay:=LIS.List(n, 3)
 wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 6) = LIS.List(n, 5) '"UNIDAD"
 wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 7) = LIS.List(n, 6) '"CANTIDAD."
 wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 8) = LIS.List(n, 7) '"PRECIO UNITARIO $"
 wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 9) = LIS.List(n, 8) '"PRECIO TOTAL $"
 nFilaSalida = nFilaSalida + 1
 NIVEL_ant = NIVEL(LIS.List(n, 0))
 RAIZ_ant = raiz(LIS.List(n, 0))
 End If
 Next
 'pone líneas de cuadrícula
 bordes nFilaSalida
 '4. Guardamos el libro
 sFileXLS = ThisWorkbook.Path & "\" & NOMBRE_DOCUMENTO & ".xlsx"
 If Dir(sFileXLS) <> "" Then
 'Comprobamos si el archivo ya existe, en este caso, lo borramos
 Kill sFileXLS
 End If
 wbNuevoLibro.SaveAs sFileXLS
 '5. Cerramos el libro
 wbNuevoLibro.Close
 '6. Cerramos el formulario. Ya no es necesario.
 Unload Me
End Sub

Saludos y muchas gracias :D