Excel. Macro para buscar archivos y generar ruta

Aclara por favor si ya sabes el nombre de la carpeta 'padre' o hay que buscarla. Y ya de allí el programa tomará las subcarpetas devolviéndote las rutas.

Y si puedes deja una imagen o comenta cuál es la col con los nombres de los archivos, si están con la extensión y en qué col debe colocarse la ruta.

Voy a intentar explicarme mejor. Tengo que ir generando tablas Excel con listados de referencias de artículos en la col A. Algunas de estas referencias tienen asociados dos archivos pdf y/o dxf con el mismo nombre que la referencia. Esto último lo indica la col C (Valor "T" ambos archivos, "F1" y F2" solo pdf y el resto ninguno) . La dificultad está en que la ubicación de las tablas Excel y los archivos no tienen una lógica repetida. Todo está dentro de una gran carpeta padre que contiene una gran cantidad de carpetas y subcarpetas por donde se distribuyen. Lo que pretendo es crear vínculos para abrir los archivos desde la tabla Excel. Para ello, como mínimo, necesito que se haga una búsqueda automática de los archivos y me devuelva la ruta en la col C.

Perdón, me he confundido. la ruta la devolvería en la col B. 

Esta es la macro según lo que entendí y la imagen es el resultado. En mi caso, la ruta de mi libro llega hasta 'Propios'.

He visto en tu consulta anterior que la ruta de tu libro llega hasta Lista, de ahí que se colocaron las 2 primeras instrucciones para encontrar la ruta de las otras 2.

Imaginé que en col A no llevan la extensión y que los archivos pueden estar sueltos en la carpeta PDF o dentro de algunas subcarpetas. Y que en la misma celda de col B se colocarán las 2 carpetas en caso de T.

Dim dire As String
Sub agregaRutas()
'x Elsamatilde
'se establecen las rutas
ruta1 = Replace(ActiveWorkbook.Path, "Listas", "PDF")
ruta2 = Replace(ActiveWorkbook.Path, "Listas", "DXF")
'se recorre la col A desde fila 2 hasta encontrar celda vacía. Fin de rango
[A2].Select
While ActiveCell <> "" And ActiveCell.Offset(0, 2) <> ""
    dato = ActiveCell.Value: dire = ""
    'se mira si en col C hay alguna clave
    If ActiveCell.Offset(0, 2) = "F1" Then   'pdf
        tipo = "pdf"
        Call buscarF(dato, ruta1, tipo)
    ElseIf ActiveCell.Offset(0, 2) = "F2" Then  'dxf
        tipo = "dxf"
        Call buscarF(dato, ruta2, tipo)
    ElseIf ActiveCell.Offset(0, 2) = "T" Then   'las 2
        tipo = "pdf"
        Call buscarF(dato, ruta1, tipo)
        tipo = "dxf"
        Call buscarF(dato, ruta2, tipo)
    End If
    If dire <> "" Then ActiveCell.Offset(0, 1) = Trim(dire)
    'continúa con el siguiente registro
    ActiveCell.Offset(1, 0).Select
Wend
MsgBox "Fin del proceso."
End Sub
Sub buscarF(refer, dir1, exten)
Dim fs, carpeta, subcarpeta
Set fs = CreateObject("Scripting.FileSystemObject")
Set carpeta = fs.GetFolder(dir1)
'se busca el archivo. Si no está se recorren las subcarpetas
For Each Archi In carpeta.Files
  If Archi = carpeta & "\" & refer & "." & exten Then
      dire = dire & " " & carpeta
      Exit For
  End If
Next
'se buscan las subcarpetas dentro de carpeta
For Each subcarpeta In carpeta.SubFolders
    'a continuación se miran los archivos
    For Each Archi In subcarpeta.Files
        If Archi = subcarpeta & "\" & refer & "." & exten Then
            dire = dire & " " & subcarpeta
            Exit For
        End If
    Next
Next
End Sub

Sdos y no olvides valorar la respuesta.

Si luego te surge hacer algún cambio x favor en nueva consulta, con todos los detalles.