Macro para combinar hojas

La siguiente macro:
  • Combina en una sola hoja varias hojas de un mismo libro
  • Cada una de las hojas que forman el libro tienen la misma estructura
En la siguiente imagen se muestran tres hojas diferentes de un mismo libro; representan las ventas de diferentes vendedores en los meses de enero, febrero y marzo.  El problema consiste en combinar las tres hojas en una sola que les hemos llamado "Consolidado".

Combinar hojas de un mismo libro

Sub consolidar()
'Consolida diferentes hojas de un mismo libro en una hoja resumen
'Toma en cuenta los encabezados de cada una de las hojas
'La macro es adaptado de Ron de Bruin 'https://www.rondebruin.nl/

Dim hoja As Worksheet
Dim hojaDestino As Worksheet
Dim rangoCopiado As Range

Dim filaInicio As Long
Dim nombreHojaConsolidado As String
Dim ultimaFilaDestino As Long
Dim ultimaColumna As Long
Dim ultimaFilaOrigen As Long

nombreHojaConsolidado = "Consolidado" 'cambiar el nombre de la hoja de consolidados si es necesario

'Parámetros para acelerar la macro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

'Borrar la hoja de consolidados (en el caso de que existiera)
On Error Resume Next
ActiveWorkbook.Worksheets(nombreHojaConsolidado).Delete

'Crear hoja  de consolidados
Set hojaDestino = ActiveWorkbook.Worksheets.Add(After:=Sheets(Sheets.Count))
hojaDestino.Name = nombreHojaConsolidado

filaInicio = 2 'fila de inicio después del encabezado

For Each hoja In ActiveWorkbook.Sheets
    If hoja.Name <> hojaDestino.Name Then

        ultimaFilaOrigen = hoja.Cells(hoja.Rows.Count, "A").End(xlUp).Row
        ultimaColumna = hoja.Cells(1, hoja.Columns.Count).End(xlToLeft).Column
        Set rangoCopiado = hoja.Range(hoja.Rows(filaInicio), hoja.Rows(ultimaFilaOrigen))
        
        ultimaFilaDestino = hojaDestino.Cells(hojaDestino.Rows.Count, "A").End(xlUp).Row
        rangoCopiado.Copy
        
        With hojaDestino.Cells(ultimaFilaDestino + 1, "A")
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
        End With
        
        hojaDestino.Cells(ultimaFilaDestino + 1, ultimaColumna + 1).Resize(rangoCopiado.Rows.Count).Value = hoja.Name
    End If
Next hoja

hojaDestino.Range("A1").Select

'Restaurar parámetros de la aplicación
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True

End Sub

Resultado al ejecutar la macro anterior:
Diferentes hojas combinadas en una sola