Abrir otros libros excel con el explorador, copiar datos y almacenarlos uno debajo de otros en el libro actual
Necesito de su valiosa ayuda, he tratado de adaptar una macro que encontré pero no puedo hacer que funcione como debe ser, la función de esta macro es hacer que a través del explorador de windows, buscar en una carpeta, o cualquier carpeta, un libro de excel (para este caso, a esta carpeta la he nombrado "REGISTROS", pero puede tener cualquier nombre y estar en cualquier parte de la PC, sin ninguna ruta específica y esa carpeta va a contener varios archivos de excel con distintos nombres), y que de ese archivo seleccionado se copien los datos contenidos en una hoja específica, y así, el proceso se tiene que repetir para los demás archivos que se necesite seleccionar, (archivo por archivo), y la información que es copiada de esos otros libros se almacenen consecutivamente uno después del otro en el libro actual desde donde se ejecuta la macro.
Por ejemplo: todos los demás libros (origen) tienen una hoja llamada "RESUMEN", y esa hoja tiene un rango (en modo de tabla, llamada "RESUMEN_BD"), de los cuales se tiene que copiar todo ese rango y pegarlo en la hoja "CONSOLIDADO" del libro actual, que es desde donde se ejecuta la macro (libro destino - "REGISTROS CONSOLIDADOS", a partir de la celda A2 hacia abajo), pero la información copiada de cada uno de los otros libros, se debe guardar una después de la otra, es decir, en la siguiente fila vacía (copiar y pegar solo en valores, sin formato), así se tendrá una sola base de datos consolidada.
1 Respuesta
Te anexo la macro
Sub Consolidar_Info()
'Por Dante Amor
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("CONSOLIDADO")
'
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione uno o varios archivos"
.Filters.Clear
.Filters.Add "archivos de excel", "*.xls*"
.FilterIndex = 1
.AllowMultiSelect = True
.InitialFileName = l1.Path
If .Show Then
For Each archivo In .SelectedItems
Set l2 = Workbooks.Open(archivo)
For Each h In l2.Sheets
If UCase(h.Name) = "RESUMEN" Then
For Each wtabla In h.ListObjects
If UCase(wtabla.Name) = "RESUMEN_BD" Then
u2 = h1.Range("A" & Rows.Count).End(xlUp).Row + 1
wtabla.Range.Copy h1.Range("A" & u2)
Exit For
End If
Next
Exit For
End If
Next
l2.Close False
Next
End If
End With
MsgBox "Fin"
End Sub'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
Gracias Dante por tu amabilidad, voy a probar tu código y te comento cómo me fue.
Hola Dante, probé la macro que me enviaste, pero no copia los datos del(os) libro(s) origen al libro actual, lo probé seleccionando un solo archivo y varios a la vez, pero no sucede nada, solo al final sale el cuadro del mensaje: "Fin"
El archivo que abras debe tener una hoja llamada "RESUMEN" y en esa hoja debes tener una tabla llamada "RESUMEN_BD", esas fueron tus indicaciones:
Todos los demás libros (origen) tienen una hoja llamada "RESUMEN", y esa hoja tiene un rango (en modo de tabla, llamada "RESUMEN_BD")
Actualiza uno de tus archivos, verifica que tengas una hoja llamada RESUMEN" y en esa hoja debes tener una tabla llamada "RESUMEN_BD".
Vuelve a probar la macro con el archivo.
'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
Buen día Dante, disculpa la molestia, he vuelto a revisar los archivos de ejemplo y todos tienen la hoja "RESUMEN" y el rango "RESUMEN_BD", pero al ejecutar tu macro, solo sale el cuadro de mensaje: "Fin", no copia los datos del archivo que seleccioné.
¿Modificaste la macro?
Prueba con la siguiente macro y me dices qué mensaje te envía.
Sub Consolidar_Info()
'Por Dante Amor
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("CONSOLIDADO")
tablas = ""
hojas = ""
'
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione uno o varios archivos"
.Filters.Clear
.Filters.Add "archivos de excel", "*.xls*"
.FilterIndex = 1
.AllowMultiSelect = True
.InitialFileName = l1.Path
If .Show Then
For Each archivo In .SelectedItems
Set l2 = Workbooks.Open(archivo)
For Each h In l2.Sheets
If UCase(h.Name) = "RESUMEN" Then
For Each wtabla In h.ListObjects
If UCase(wtabla.Name) = "RESUMEN_BD" Then
u2 = h1.Range("A" & Rows.Count).End(xlUp).Row + 1
wtabla.Range.Copy h1.Range("A" & u2)
tablas = ""
Exit For
Else
tablas = tablas & wtabla.Name & ", "
End If
Next
hojas = ""
Exit For
Else
hojas = hojas & h.Name & ", "
End If
Next
l2.Close False
Next
End If
End With
If hojas <> "" Then
MsgBox "No existe la hoja 'RESUMEN'" & "solamente estas hojas : " & hojas
End If
If tablas <> "" Then
MsgBox "No existe la tabla 'RESUMEN_BD'" & "solamente estas tablas : " & tablas
End If
MsgBox "Fin"
End SubTambién envíame una imagen de tu libro donde se vea el nombre de la hoja "RESUMEN" y dentro de esa hoja debe estar la tabla con el nombre "RESUMEN_BD", para revisarlos.
Sale este mensaje: No existe la tabla "RESUMEN_BD" solamente estas tablas: "RESUMEN_BDTabla". Pero en el archivo del cual se quiere importar los datos, en el Administrador de nombres (del menú "Fórmulas"), tengo estos datos: en la columna "Nombre" dice: RESUMEN_BD y en la columna "Se refiere a" dice: =RESUMEN_BDTabla Como te darás cuenta el nombre "RESUMEN_BD" es el nombre del rango que tiene los datos que se deben copiar, y éste rango forma parte de la tabla que tiene como nombre "RESUMEN_BDTabla", lo que vi en tu código es que haces referencia a toda la tabla (es decir, con todo y encabezado), y lo único que se debe copiar es el rango que forma parte de la tabla, el cual hace referencia solo a los datos, más no a los encabezados. He probado cambiando en tu código en la parte: If UCase(wtabla.Name) = "RESUMEN_BD" Then ; le puse If UCase(wtabla.Name) = "RESUMEN_BDTabla" Then ; cambiando el nombre de la tabla para ver si así copia toda la tabla, pero no, no lo copia, y al final sale el mismo mensaje.
Pero no pusiste la imagen. Puedes poner la imagen para ver los nombres.
Regreso a tu petición original:
Todos los demás libros (origen) tienen una hoja llamada "RESUMEN", y esa hoja tiene un rango (en modo de tabla, llamada "RESUMEN_BD")
En tu petición original dice que tienes una tabla llamada "RESUMEN_BD", entonces si en la hoja "RESUMEN" creas una tabla, con el rango que quieras, con el nombre "RESUMEN_BD" verás que la macro funciona.
Prueba nuevamente.
No olvides la imagen.
Esta es la captura de pantalla del libro origen y muestra lo que te comenté anteriormente, sobre el rango de la tabla que contiene los datos que se deben copiar y la tabla completa (que incluye los encabezados).
Tal vez es tu versión de excel que no reconoce esta instrucción:
For Each wtabla In h.ListObjects
La macro funciona bien en las pruebas que realicé.
Prueba la macro con el siguiente archivo:
Sí, efectivamente, copia toda la tabla (con los encabezados incluidos), pero lo único que se deben de copiar son los valores de los datos que tiene la tabla (sin los encabezados por supuesto), por eso es que creé un rango "dinámico" dentro de la misma tabla que no incluyen los encabezados, y a este rango "dinámico" le puse como nombre "RESUMEN_BD", este rango es el que aparece en la imagen que te envié con las líneas punteadas, está encerrando solo los datos, más no los encabezados. No sé si me expliqué bien.
Regreso a tu petición original:
Por ejemplo: todos los demás libros (origen) tienen una hoja llamada "RESUMEN", y esa hoja tiene un rango (en modo de tabla, llamada "RESUMEN_BD"), de los cuales se tiene que copiar todo ese rango y pegarlo en la hoja "CONSOLIDADO"
Estás mencionando que vas a tener: "un rango (en modo de tabla, llamada "RESUMEN_BD")"
Lo que hace la macro es copiar ese rango, nunca mencionaste que debía copiarse sin encabezados.
Con todo gusto te ayudo con tus peticiones, pero la macro está funcionando desde el principio.
Valora la respuesta y crea una nueva pregunta, aclarando con ejemplos, qué datos quieres copiar. Si detalles con imágenes tus preguntas será más fácil entender desde el inicio tu requerimiento y de esa forma se podrá genera la macro adecuada.
