Crear hipervinculo solo con una parte de nombre de archivo

[Xarlie]

Buen día

les saludo, les quería comentar una gran duda que tengo la verdad he visto varias macros en la cuales crean hipervinculos a partir de un valor de celda.

pero en realidad quisiera saber una cuestión.

imaginemos que tengo el numero de una factura en varias celdas, y quiero jalar la imagen de la factura, y estan asi en las celdas:

A2=3

A3=5

A4=6

pero en la carpeta están los números de factura pero de esta manera

C:\Users\doctor\Desktop\Control de Base de datos

esta

Factura=3

Factura=5

Factura=6

entonces quisiera saber como indicarle a la macro que busque el A2,A3,A4 ETC. en la carpeta que especifiqué, aunque este numero de factura tenga "Factura=" en letras antes del numero, y que esto lo busque en un rango indefinido que para hasta la ultima Celda vacía.

les pongo el código que me sirva convertir en hipervinculos todos los datos de esa carpeta el inconveniente es que ahora tengo alrededor de 5000 imágenes

esta macro como les digo jala los datos de la carpeta pero en realidad quiero que los valores que ya tengo en la hoja se conviertan en hipervinculos.

Espero me puedan ayudar y gracias de antemano por tomarse el tiempo de resolver esta clase de confictos

de verdad gracias

Sub ListarFicherosCarpeta()
Columns("A:A").Select
    Selection.ClearContents
Range("A2").Select
Dim Ruta As String
Dim p As String
p = Range("C1").Value
Set fso = CreateObject("Scripting.FileSystemObject")
Ruta = "C:\Users\CCHUN\Desktop\papele\IMagenes" & p
Set Carpeta = fso.GetFolder(Ruta)
Set ficheros = Carpeta.Files
With Range("A1")
    .Value = "Ficheros de la carpeta " & Ruta
    .Font.Bold = True

End With
Range("A2").Select
For Each Archivo In ficheros
ActiveCell = Archivo.Name
ActiveCell.Offset(1, 0).Select
Next Archivo
ActiveCell.EntireColumn.AutoFit
Set fso = Nothing
Set Carpeta = Nothing
Set ficheros = Nothing
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim p As String
p = Range("C1").Value
If Not Intersect(Target, Range("A:A")) Is Nothing Then
Ruta = "C:\Users\CCHUN\Desktop\papele\IMagenes" & p & "\"
fichero = Target.Value
direccion = Ruta & fichero
    If Target.Value = "" Then
    Exit Sub
    Else
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=direccion, TextToDisplay:=fichero
    End If
End If
End Sub
'esta de abajo es la que no puedo adaptar a mi macro


Function EXTRAENUM(cadena As String)

Dim numeros As String
numeros = ""

For i = 1 To Len(cadena)

    If IsNumeric(Mid(cadena, i, 1)) Then
         numeros = numeros & Mid(cadena, i, 1)

    End If
Next
EXTRAENUM = numeros

End Function
For Each Celda In Range(ActiveCell, ActiveCell.End(xlDown))
ActiveSheet.Hyperlinks.Add Anchor:=Celda, Address:=Celda.Value
Next Celda
endsub
[/PHP]

[Xarlie]

LEs saludo, con respecto a este tema quería molestarlos con una respuesta ya sea positiva o negativa para no dejar el tema pendiente

gracias por su atencion