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:
Ahora sólo tenemos que especificar el archivo de destino, puede existir o no, el proceso lo sustituye:
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:
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
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.