Hipervínculo hacia otro libros

junto con saludar quisiera saber si me puede ayudar con una duda que tengo en el formulario, estoy tratando de pasar los hipervínculos que ingreso hacia los libros que voy generando, lo cual me los pasa, mi duda esta en que paso los hipervínculos pero si selecciono una celda que no tiene hipervínculo igual me lo gener

Saludos y gracias :D

pd: si tengo un archivo word "doc" yal pasar el hipervínculo solo me habré los archivos "docx" como hago para que me habrá las dos extensiones

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"
 'se pasa los hipervinculos de ListaB
 wbNuevoLibro.Worksheets(1).Hyperlinks.Add Anchor:=Cells(nFilaSalida, 3), Address:= _
 ThisWorkbook.Path & "\Lista B\" & Cells(nFilaSalida, 3) & ".docx", ScreenTip:="abrir"
 wbNuevoLibro.Worksheets(1).Cells(nFilaSalida, 5) = LIS.List(n, 4) '"Estandar"
 'Se Pasa los hipervinculos de estandar
 'en esta parte paso los hipervinculos a los libros que voy generando
 wbNuevoLibro.Worksheets(1).Hyperlinks.Add Anchor:=Cells(nFilaSalida, 4), Address:= _
 ThisWorkbook.Path & "\Estandar\" & Cells(nFilaSalida, 4) & ".pdf", ScreenTip:="abrir"
 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