VBA – Combinar Varios Archivos de Excel en un solo Libro

Este tutorial le mostrará cómo combinar múltiples archivos de Excel en un libro de trabajo en VBA.

La creación de un solo libro de trabajo a partir de varios libros de trabajo, utilizando VBA requiere una serie de pasos a seguir.

• Debe seleccionar los libros de trabajo de los que desea obtener los datos de origen – los archivos de origen.
• Debe seleccionar o crear el libro de trabajo en el que desea colocar los datos: el archivo de destino.
• Debe seleccionar las hojas de los archivos de origen que necesita.
• Debe indicar al código dónde colocar los datos en el archivo de destino.

Combinar todas las hojas de todos los libros abiertos en un nuevo libro como hojas individuales

En el código que se muestra a continuación, los archivos de los que necesita copiar la información deben estar abiertos, ya que Excel recorrerá los archivos abiertos y copiará la información en un nuevo libro. El código se coloca en el libro de trabajo de la macro personal.

Estos archivos son los ÚNICOS archivos de Excel que deben estar abiertos.

Sub CombinarMultiplesArchivos()
    On Error GoTo eh
    'declarar variables para contener los objetos necesarios
    Dim wbDestination As Workbook
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wb As Workbook
    Dim sh As Worksheet
    Dim strSheetName As String
    Dim strDestName As String
    'desactivar la actualización de la pantalla para acelerar el proceso
    Application.ScreenUpdating = False
    'primero crear un nuevo libro de trabajo de destino
    Set wbDestination = Workbooks.Add
    'obtener el nombre del nuevo libro de trabajo para excluirlo del bucle siguiente
    strDestName = wbDestination.Name
    'ahora haga un bucle a través de cada uno de los libros de trabajo abiertos para obtener los datos, ...
    '...pero excluya su nuevo libro o el libro de trabajo de la macro personal
    For Each wb In Application.Workbooks
       If wb.Name <> strDestName And wb.Name <> "PERSONAL.XLSB" Then
          Set wbSource = wb
          For Each sh In wbSource.Worksheets
             sh.Copy After:=Workbooks(strDestName).Sheets(1)
          Next sh
       End If
    Next wb
    'Ahora cierre todos los archivos abiertos excepto el nuevo archivo y el libro de trabajo de la macro personal.
    For Each wb In Application.Workbooks
        If wb.Name <> strDestName And wb.Name <> "PERSONAL.XLSB" Then
            wb.Close False
        End If
    Next wb
 
    'eliminar la hoja uno del libro de trabajo de destino
    Application.DisplayAlerts = False
    Sheets("Hoja1").Delete
    Application.DisplayAlerts = True
    'limpiar los objetos para liberar la memoria
    Set wbDestination = Nothing
    Set wbSource = Nothing
    Set wsSource = Nothing
    Set wb = Nothing
    'activar la actualización de la pantalla cuando se haya completado
    Application.ScreenUpdating = False
    Exit Sub
eh:
    MsgBox Err.Description
End Sub

Haga clic en el cuadro de diálogo de la macro para ejecutar el procedimiento desde la pantalla de Excel.

Ahora se mostrará su archivo combinado.

Este código ha recorrido cada archivo y ha copiado la hoja en un nuevo archivo. Si alguno de sus archivos tiene más de una hoja – también las copiará – ¡incluyendo las hojas que no tienen nada!

Combinar todas las hojas de todos los libros abiertos en una sola hoja de trabajo en un nuevo libro

El siguiente procedimiento combina la información de todas las hojas de todos los libros de trabajo abiertos en una sola hoja de trabajo en un nuevo libro de trabajo que se crea. La información de cada hoja se pega en la hoja de destino en la última fila ocupada de la hoja de trabajo.

Sub CombinarMultiplesArchivos()
    On Error GoTo eh
    'declarar variables para contener los objetos necesarios
    Dim wbDestination As Workbook
    Dim wbSource As Workbook
    Dim wsDestination As Worksheet
    Dim wb As Workbook
    Dim sh As Worksheet
    Dim strSheetName As String
    Dim strDestName As String
    Dim iRws As Integer
    Dim iCols As Integer
    Dim totRws As Integer
    Dim strEndRng As String
    Dim rngSource As Range
    'desactivar la actualización de la pantalla para acelerar las cosas
    Application.ScreenUpdating = False
    'primero crear un nuevo libro de trabajo de destino
     Set wbDestination = Workbooks.Add
    'obtener el nombre del nuevo libro de trabajo para excluirlo del bucle siguiente
    strDestName = wbDestination.Name
    'Ahora, recorreo a través de cada uno de los libros de trabajo abiertos para obtener los datos
    For Each wb In Application.Workbooks
        If wb.Name <> strDestName And wb.Name <> "PERSONAL.XLSB" Then
            Set wbSource = wb
            For Each sh In wbSource.Worksheets
                'obtener el número de filas y columnas de la hoja
                sh.Activate
                ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Activate
                iRws = ActiveCell.Row
                iCols = ActiveCell.Column
                'establecer el rango de la última celda de la hoja
                strEndRng = sh.Cells(iRws, iCols).Address
                'establecer el rango de origen a copiar
                Set rngSource = sh.Range("A1:" & strEndRng)
                'encontrar la última fila de la hoja de destino
                wbDestination.Activate
                Set wsDestination = ActiveSheet
                wsDestination.Cells.SpecialCells(xlCellTypeLastCell).Select
                totRws = ActiveCell.Row
                'comprobar si hay suficientes filas para pegar los datos
                If totRws + rngSource.Rows.Count > wsDestination.Rows.Count Then
                    MsgBox "No hay suficientes filas para colocar los datos en la hoja de trabajo de Consolidación."
                    GoTo eh
                End If
                'añadir una fila para pegar en la siguiente fila hacia abajo
                If totRws <> 1 Then totRws = totRws + 1
                rngSource.Copy Destination:=wsDestination.Range("A" & totRws)
            Next sh
        End If
    Next wb
    'ahora cierra todos los archivos abiertos excepto el que quieres
    For Each wb In Application.Workbooks
        If wb.Name <> strDestName And wb.Name <> "PERSONAL.XLSB" Then
            wb.Close False
        End If
    Next wb
    'limpiar los objetos para liberar la memoria
    Set wbDestination = Nothing
    Set wbSource = Nothing
    Set wsDestination = Nothing
    Set rngSource = Nothing
    Set wb = Nothing
    'encender la actualización de la pantalla cuando se haya completado
    Application.ScreenUpdating = False
    Exit Sub
eh:
    MsgBox Err.Description
End Sub

Combinando todas las hojas de todos los libros abiertos en una sola hoja de trabajo en un libro activo

Si desea traer la información de todos los demás Libros de Trabajo abiertos al que está trabajando actualmente, puede utilizar este código.

Sub CombinarMultiplesHojasEnLibroExistente()
    On Error GoTo eh
    'declarar variables para contener los objetos necesarios
    Dim wbDestination As Workbook
    Dim wbSource As Workbook
    Dim wsDestination As Worksheet
    Dim wb As Workbook
    Dim sh As Worksheet
    Dim strSheetName As String
    Dim strDestName As String
    Dim iRws As Integer
    Dim iCols As Integer
    Dim totRws As Integer
    Dim rngEnd As String
    Dim rngSource As Range
    'establecer el objeto de libro de trabajo activo para el libro de destino
    Set wbDestination = ActiveWorkbook
    'obtener el nombre del archivo activo
    strDestName = wbDestination.Name
    'desactivar la actualización de la pantalla para acelerar las cosas
    Application.ScreenUpdating = False
    'primero cree una nueva hoja de destino en su libro de trabajo activo
    Application.DisplayAlerts = False
    'resume next error en caso de que la hoja no exista
    On Error Resume Next
    ActiveWorkbook.Sheets("Consolidation").Delete
    'Atrapar el error para ir a la trampa de error al final
    On Error GoTo eh
    Application.DisplayAlerts = True
    'añadir una nueva hoja al libro de trabajo
    With ActiveWorkbook
        Set wsDestination = .Sheets.Add(After:=.Sheets(.Sheets.Count))
        wsDestination.Name = "Consolidation"
    End With
    'Ahora, recorrer a través de cada uno de los libros de trabajo abiertos para obtener los datos
    For Each wb In Application.Workbooks
        If wb.Name <> strDestName And wb.Name <> "PERSONAL.XLSB" Then
            Set wbSource = wb
            For Each sh In wbSource.Worksheets
                'obtener el número de filas de la hoja
                sh.Activate
                ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Activate
                iRws = ActiveCell.Row
                iCols = ActiveCell.Column
                rngEnd = sh.Cells(iRws, iCols).Address
                Set rngSource = sh.Range("A1:" & rngEnd)
                'encontrar la última fila de la hoja de destino
                wbDestination.Activate
                Set wsDestination = ActiveSheet
                wsDestination.Cells.SpecialCells(xlCellTypeLastCell).Select
                totRws = ActiveCell.Row
                'comprobar si hay suficientes filas para pegar los datos
                If totRws + rngSource.Rows.Count > wsDestination.Rows.Count Then
                    MsgBox "No hay suficientes filas para colocar los datos en la hoja de trabajo de Consolidación."
                    GoTo eh
                End If
                'añadir una fila para pegar en la siguiente fila hacia abajo si no está en la fila 1
                If totRws <> 1 Then totRws = totRws + 1
                rngSource.Copy Destination:=wsDestination.Range("A" & totRws)
            Next sh
        End If
    Next wb
    'ahora cierra todos los archivos abiertos excepto el que quieres
    For Each wb In Application.Workbooks
        If wb.Name <> strDestName And wb.Name <> "PERSONAL.XLSB" Then
            wb.Close False
        End If
    Next wb

    'limpiar los objetos para liberar la memoria
    Set wbDestination = Nothing
    Set wbSource = Nothing
    Set wsDestination = Nothing
    Set rngSource = Nothing
    Set wb = Nothing
    'Activar la actualización de la pantalla cuando se haya completado
    Application.ScreenUpdating = False
    Exit Sub
eh:
    MsgBox Err.Description
End Sub