Macro Junta archivos excel en un solo archivo

Esta macro junta archivos que están en la misma carpeta que el archivo que contiene la macro, y los coloca en un solo archivo pero en hojas diferentes.

El problema es que solo me funciona si la carpeta que contiene el archivo esta alojada en el disco "C".

Yo quisiera saber si es posible que funcione también si la carpeta se encuentra en cualquier partición del disco o en una memoria extraible o externa.

Sub juntar()
Dim hoja As Object
Application.DisplayAlerts = False
mio = ActiveWorkbook.Name
ruta = ActiveWorkbook.Path
ChDir ruta & "\"
archi = Dir("*.csv*")
Do While archi <> mio And archi <> ""
Workbooks.Open archi
otro = ActiveWorkbook.Name
For Each hoja In ActiveWorkbook.Sheets
hoja.Copy After:=Workbooks(mio).Sheets(Workbooks(mio).Sheets.Count)
Next
Workbooks(otro).Close False
archi = Dir()
Loop
n = 1
End Sub

Muchas gracias

2 respuestas

Respuesta
1

En realidad la macro funciona no importa en qué disco esté siempre y cuando el libro que contiene la macro y el resto se encuentren en la misma ubicación, por esta línea:

ruta = ActiveWorkbook.Path

En mi caso uso la partición D y no tengo que hacerle ningún ajuste.

Aclara x favor, si lo que intentas es tener el libro con la macro en una ubicación y el resto en otra. En ese caso tendrás que decidir si dejarás indicada la ruta en alguna celda, o se podrá utilizar el explorador para buscarla.

Sdos

Gracias por tu respuesta Elsa.

El problema es el siguiente: Tengo una carpeta donde se encuetra el libro con la macro junto a los archivos que deseo juntar alojados en el disco C (en este caso funciona perfectamente).

Ahora, copio la misma carpeta y la pego en el disco D, y la macro no funciona... no me da error, pero no junta los archivos.

En cuanto a la aclaración que pedías, lo que necesito es que el libro con la macro esté junto a los demás archivos, todos en la misma carpeta.

Muchas gracias!

Si la carpeta está ubicada junto al libro con la macro no hace falta nada más que la instrucción :

ruta = ActiveWorkbook.Path

Quedándote las instrucciones así:

Sub juntar()
Dim hoja As Object
Application.DisplayAlerts = False
mio = ActiveWorkbook.Name
ruta = ActiveWorkbook.Path
archi = Dir("*.csv*")
Do While archi <> mio And archi <> ""
Workbooks.Open archi
otro = ActiveWorkbook.Name
For Each hoja In ActiveWorkbook.Sheets
hoja.Copy After:=Workbooks(mio).Sheets(Workbooks(mio).Sheets.Count)
Next
Workbooks(otro).Close False
archi = Dir()
Loop
n = 1
End Sub

No necesitas buscar la ruta como te comentaron hace un rato ni nada ... así queda perfecto.

Sdos!

Elsa, gracias nuevamente .

Si no entendí mal, lo que sugeriste era sacar esta línea --ChDir ruta & "\"-- dejando el resto como estaba.

Probé con eso pero lamentablemente sigo con el mismo problema. No funciona si coloco los archivos en otra partición.

Reitero lo comentado antes:

En realidad la macro funciona no importa en qué disco esté siempre y cuando el libro que contiene la macro y el resto se encuentren en la misma ubicación, por esta línea:

ruta = ActiveWorkbook.Path

En mi caso uso la partición D y no tengo que hacerle ningún ajuste.

Puedo enviarte una carpeta para que la pruebes y así determinás si no habrá otras macros que estén interfiriendo.,,, dejame un correo o escribime al mío que aparece en mi sitio.

Sdos!

[email protected]

Muchas gracias!

Enviado!

Muchas gracias!

Ejecuté la macro en el libro que me enviaste, pero sigo con el mismo problema. al colocarlo en otra partición del disco, la macro no funciona.

Hice la prueba en otra PC y es lo mismo...

Disculpa la demora, pero no estoy recibiendo los avisos del foro ¿? Ya te envié libro correcto. Dejo el código aquí que tenía un problema con el DO.

Sub juntar()
Dim hoja As Object
Application.DisplayAlerts = False
mio = ActiveWorkbook.Name
ruta = ActiveWorkbook.Path & "\"
ChDir ruta
archi = Dir("*.csv*")
Do
If archi <> mio And archi <> "" Then
    Workbooks.Open archi
    otro = ActiveWorkbook.Name
    For Each hoja In ActiveWorkbook.Sheets
    hoja.Copy After:=Workbooks(mio).Sheets(Workbooks(mio).Sheets.Count)
    Next
    Workbooks(otro).Close False
End If
archi = Dir()
Loop While archi <> ""
End Sub

Sdos!

Perdón por la demora. Probé la macro que me mandaste y me toé con el siguiente problema:

Abro un libro nuevo en excel, luego lo guardo en otra unidad que no sea el "C" como "una plantilla de excel habilitada para macros"... corro la macro y funciona (junta los archivos y al final me da un error 1004 en la linea de ---Workbooks.Open archi--- pero por lo menos junta los archivos). Luego de cerrar el libro y abrirlo nuevamente, la macro deja de funcionar.

No se si estoy configurando algo mal, o si estoy equivocando algún procedimiento de guardado.

Muchas gracias!!

Acabo de probarlo dejando otros archivos distintos en la misma carpeta, abriendo y cerrando y no me da error.

Si ya juntó los archivos en tu libro principal, podés colocar un control de error, para que al final se detenga.

En la rutina no se está 'guardando' nada .. así que aquí no hay error posible.

Si recuerdo que al guardar una hoja como csv es posible que Excel te comente de problemas de formato, etc. En ese caso uno acepta y sigue ... pero esos mensajes son al 'cerrar' un csv... nada que ver con la macro.

Pasame tu libro, en el que tengas esta macro y cualquier otra que afecte la apertura o cambio de ruta.

Sdos!

Respuesta
1

Como estas

Para que puedas importar archivos de cualquier ruta, necesariamente debes tener una Ventana de dialogo abrir, con esto cada vez que quieras importar archivos tu mismo puedas seleccionarlos.

Aquí te pongo el código

Sub juntar()
Dim hoja As Object
Application.DisplayAlerts = False
mio = ActiveWorkbook.Name
'Ventana paa seleccionar los archivos CSV
X = Application.GetOpenFilename _
("CSV Files (*.CSV), *.Csv", 2, "Abrir archivos", , True)
If IsArray(X) Then
    For a = LBound(X) To UBound(X)
        Workbooks.Open X(a)
        otro = ActiveWorkbook.Name
        For Each hoja In ActiveWorkbook.Sheets
            hoja.Copy After:=Workbooks(mio).Sheets(Workbooks(mio).Sheets.Count)
        Next
        Workbooks(otro).Close False
    n = 1
Next
End If
End Sub

Ejecutas la macro, luego te pide seleccionar uno o varios archivos para luego importarlos.

Freddy, muchas gracias por tu respuesta. 

No es específicamente lo que necesito, sólo quería subsanar este pequeño error que tengo en la macro que estoy usando, ya que con ella puedo ahorrarme el tiempo que necesito en seleccionar los archivos.

Si aun no pudiste resolver tu problema, te agradecería que compartas tu carpeta con los archivos y la macro para poder ayudarte.

No he podido solucionar el problema todavía.

Subí los archivos a este servidor, desde ahí se los puede descargar. el archivo se llama "juntar archivos.rar".

http://depositfiles.org/files/0xh4f71ql 
Muchas gracias!

No tengo ningún problema al ejecutar la macro. Me juntan todos los archivos que están en la carpeta, aun así lo ponga en cualquier ruta.

Quizás la única manera de ayudarte sea de manera remota si así lo deseas.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas