Truco Excel. Unir todos los libros en una hoja

unir_excel1

Los trucos Excel referentes a la unión de varios libros en uno tienen mucho éxito en esta web, además era necesario crear una versión que uniera de forma horizontal. No es una unión como la pueda hacer Power Query de anexar tablas con cierto sentido teniendo en cuenta el nombre de las columnas y demás, se trata
de unir todas las celdas de un conjunto de libros de forma horizontal en otro libro resultante como ilustra la figura de arriba. Se unirán todos los campos unos encima de otros independientemente de si se llaman igual o no, si queremos anexar tablas es recomendable usar herramientas más específicas. El funcionamiento es muy sencillo pero
lo vamos a ilustrar con imágenes, el primer paso es pulsar directamente el botón y seleccionar los archivos a unir:

unir_excel2

Ahora sólo tenemos que especificar el archivo de destino, puede existir o no, el proceso lo sustituye:

unir_excel3

Y et voilá! Ya tenemos nuestro archivo resultante. Un funcionamiento sencillo pero el código visual basic empleado tiene algunas particularidades que pueden interesaros para otros procesos, por eso os resumo su funcionamiento:

[sourcecode language=”vb”]
Sub Abrir()
Dim Hoja As Object, rango As String
Dim X As Variant

Application.ScreenUpdating = False
‘Seleccionar archivos a abrir
X = Application.GetOpenFilename(FileFilter:="Archivo Excel (*.xls*), *.xls*", _
Title:="Seleccionar Excel a unir", MultiSelect:=True)

‘Se ejecuta si se seleccionan archivos
If IsArray(X) Then
‘Se va a generar un nuevo Excel
Workbooks.Add
‘Seleccionar el archivo a guardar
Final = Application.GetSaveAsFilename(InitialFileName:="*.xlsx",_
FileFilter:="Archivo Excel (*.xlsx), *.xlsx", Title:="Guardar como")
ActiveWorkbook.SaveAs (Final)
resultado = ActiveWorkbook.Name

largo = 0
For i = LBound(X) To UBound(X)
Workbooks.Open X(i)
nombre = ActiveWorkbook.Name
If i = 1 Then celda = "A1"
If i > 1 Then celda = "A2"

‘Esta parte es interesante porque nos permite copiar y pegar aunque haya celdas en blanco
With Range(celda)
.Resize(Cells(Rows.Count, "A").End(xlUp).Row – (.Row – 1), _
Cells(5, Columns.Count).End(xlToLeft).Column – (.Column – 1)).Copy
End With

‘Nos ubicamos en el punto que tiene valores más uno
Windows(resultado).Activate
Cells(largo + 1, 1).Select
ActiveSheet.Paste
largo = Cells(Rows.Count, 1).End(xlUp).Row

Workbooks(nombre).Close SaveChanges:=False

Next
End If
Windows(resultado).Activate
ThisWorkbook.Save
‘ActiveWorkbook.SaveAs (Final)

Application.ScreenUpdating = True
End Sub
[/sourcecode]

Abrimos un array de libros de Excel y seleccionamos donde guardamos, bajo mi punto de vista la parte más interesante del código es esta:

With Range(celda)
.Resize(Cells(Rows.Count, “A”).End(xlUp).Row – (.Row – 1), _
Cells(5, Columns.Count).End(xlToLeft).Column – (.Column – 1)).Copy
End With

Nos permite seleccionar el rango a copiar aunque haya registros sin datos o celdas en blanco, el método que usaba habitualmente tenía este problema. El último paso del proceso lo que hace es situar la celda seleccionada en el último registro y lo hace midiendo la longitud del rango seleccionado con largo = Cells(Rows.Count, 1).End(xlUp).Row la primera celda sin datos será el largo más uno y ahí pegará los datos copiados del siguiente libro y de este modo realiza el proceso iterativo. Al final de todo se guarda el resultado y ya tenemos nuestros datos anexados. Para descargaros directamente el Excel que realiza la tarea pulsad en el siguiente link:

Unir horizontalmente libro de Excel comprimido

Espero que sea de utilidad, yo creo que si.

Tags:

Comments are closed.