Macro para abrir archivos y trabajarlos
Tengo un problema con una macro que estoy realizando. Verán, lo que debe hacer la macro es abrir los documentos de una ruta (esta ruta puede cambiar por lo que cree un browse folder) cuando selecciona la carpeta donde están los documentos, debe: abrir el documento, copiar la información, pegarla en el libro donde está la macro y luego cerrar el archivo, así con cada uno de los documentos que tiene la carpeta.
La macro que realice para dicho procedimiento es:
Subir leer_archicvos ()
Dim directorio as string, titulo as string
Título = "Seleccione la carpeta que contiene los archivos"
On error resume next
'abre El buscador de ruta
Whit CreateObject ("shell.application")
Directorio= . BrowseForFolder (0, titulo, 0).Items.Item.path
End with: on error goto 0
If directorio = "" then
Msgbox "You don't select any file Directory.", , "Cancelled operation.!!!"
Exit sub
End if
Dim carpeta, archivos as string
Dim contador as integer
Dim archivos1 as string
Application.displayalerts= false
Contador= 1
Archivos=directorio & "\" & dir(directorio & "\")
Do while Len(archivos) >0
On error resume next
If archivos <> directorio & "\" then
'abre los archivos de la ruta
Archivos=dir()
Archivos1=archivos
Archivos = directorio & "\" & archivos
Workbooks. Open(archivos)
'copia info
Windows (archivos1). Activate
Range("a2").select
Selection. Copy
Windows(macro.xlsm). Activate
Range("a2").select
Selection.end(xlDown).select
Activecell.offset(1,0).select
Activesheet.paste
Contador = contador + 1
Else
Exit sub
End if
Loop
End sub
El problema que me está pasando es que cuando abre la ruta, el primer archivo que hay no lo abre, pasa directamente al segundo... Y que al terminar de abrir todos los archivos, realiza el procedimiento de la macro dentro de la página macro, es decir que copia nuevamente todos los archivos que ya copio en el libro de la macro.
Agradezco enormemente el tiempo y la ayuda que me puedan dedicar