Problemas con macro creado en Excel 2003?

Prueba la siguiente:

Sub busqueda(Fila_actual, Fila_final, Columna_actual)
Dim fecha As String
Dim final As String
Dim indice As String
Dim longitudarchivo
Dim prefijo As String
ReDim lista(1 To 1)
ReDim archivo(1 To 1)
carpeta = ActiveWorkbook.Path
ChDir carpeta
Dim archivos As New Collection
archi = Dir("*.dwg")
n = 1
Do While archi <> ""
    archivos.Add archi
    n = n + 1
    archi = Dir()
Loop
cuantos = archivos.Count
If cuantos > 0 Then
    n_datos = cuantos
    ReDim lista(n_datos)
    ReDim archivo(n_datos)
    For i = 1 To cuantos
        direccion = archivos(i)
        dato = ""
        dato_inicial = direccion
        dato_segundo = Trim(dato_inicial)
        dato_temp = Split(dato_segundo, "-", -1)
        separados = UBound(dato_temp)
        dato = dato_temp(0)
        If separados > 0 Then
            For n = 1 To separados
                dato = dato + dato_temp(n)
            Next n
        End If
        lista(i) = ELIMINAR(direccion)
        archivo(i) = direccion
    Next i
Else
    MsgBox "There were no files found."
End If
For x = Fila_actual To Fila_final
    dato = ""
    dato_inicial = Cells(x, Columna_actual)
    dato_segundo = Trim(dato_inicial)
    dato_temp = Split(dato_segundo, " ", -1)
    separados = UBound(dato_temp)
    On Error Resume Next
    dato = dato_temp(0)
    If separados > 0 Then
        For n = 1 To separados
            dato = dato + dato_temp(n)
        Next n
    End If
    dato = ELIMINAR(dato_inicial)
    For i = 1 To n_datos
        VALOR = Split(lista(i), dato, -1)
        If UBound(VALOR) > 0 Then
            If VALOR(1) = "dwg" Then ' esto es por si el plano lo he editado yo y añadido alguna revision
                Call vinculo(dato, archivo(i), x, Columna_actual + 1)
                Exit For
            End If
        End If
    Next i
Next x
End Sub

Saludos.Dante Amor
Si es lo que necesitas.