macro, unir hojas de diferentes libros d excel

publicado por: Anonymous

Soy investigador de macros en excel, hasta ahora me considero un principiante en esta labor, necesito su ayuda para poder resolver un problema.

Necesito unir varios archivos de excel en uno solo, esto lo he podido lograr con una macro como:

Sub simpleXlsMerger()
Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")

'NOTA: CAMBIA C:Usersf13619DesktopBBBBBB POR LA RUTA QUE TENGAS TUS ARCHIVOS

Set dirObj = mergeObj.Getfolder("C:Usersf13619DesktopBBBBBB")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)
'change "A2" with cell reference of start point for every files here
'for example "B3:IV" to merge all files start from columns B and rows 3
'If you're files using more than IV column, change it to the latest column
'Also change "A" column on "A65536" to the same column as start point
Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate
'Do not change the following column. It's not the same column as above
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
bookList.Close
Next
End Sub

pero quisiera saber que debo cambiar en este código porque solo une las primeras hojas y lo que necesito es unir todas las hojas 1 en una sola hoja 1, todas las hojas 2 en una sola hoja 2…. y así sucesivamente, debo mencionar que todas las hojas tienen la misma estructura, de antemano, gracias por su apoyo espero haberme expresado bien.

Gracias

solución

Le aconsejaría que para unir hojas en excel usara Power Query en lugar de VBA con unos pocos clics tiene los resultados esperados y es mas estable y rápido que una macro.

Para la macro sería:

Sub simpleXlsMerger()
Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Dim i, WS_Count, WS_Count2 As Integer
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")

'NOTA: CAMBIA C:Usersf13619DesktopBBBBBB POR LA RUTA QUE TENGAS TUS ARCHIVOS

Set dirObj = mergeObj.Getfolder("C:Usersf13619DesktopBBBBBB")
Set filesObj = dirObj.Files

Workbooks.Add 'crea archivo nuevo para almacenar hojas unidas
ActiveWorkbook.SaveAs Filename:="master.xlsx" 'guarda archivo en documentos

For Each everyObj In filesObj
    Set bookList = Workbooks.Open(everyObj)
    WS_Count = bookList.Worksheets.Count 'cuenta cuantas hojas hay en el libro
    For i = 1 To WS_Count 'En esta linea itera por cada hoja del libro
        bookList.Worksheets(i).Activate 'hoja a unir
        Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy
        Workbooks("master.xlsx").Worksheets(i).Activate
        Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
        Application.CutCopyMode = False
        WS_Count2 = Workbooks("master.xlsx").Worksheets.Count 'cuenta cuantas hojas hay en master
        If WS_Count2 < WS_Count Then
            Sheets.Add After:=ActiveSheet 'adiciona nueva hoja
        End If
    Next i
    bookList.Close
Next
End Sub
Respondido por: Anonymous

Leave a Reply

Your email address will not be published. Required fields are marked *