Macro para unir información de varias hojas en una hoja resumen

En la solución siguiente que uds brindaron:

Sub ejemplo()
'por luismondelo
Application.DisplayAlerts = False
For Each hoja In ActiveWorkbook.Sheets
If hoja.Name = "todas" Then hoja.Delete
Next
Sheets.Add before:=Sheets(1)
ActiveSheet.Name = "todas"
For x = 2 To Sheets.Count
Sheets(x).Select
Range("b10:g" & Range("a65000").End(xlUp).Row).Copy
Sheets("todas").Range("a65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Next
Sheets("todas").Select
End Sub

Quisiera poder modificarla para incluir en la hoja resumen, una columna con el nombre de la hoja de la cual proviene cada dato.

2 respuestas

Respuesta
1

Prueba con lo siguiente:

Sub ejemplo()
'por luismondelo
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    For Each hoja In ActiveWorkbook.Sheets
        If hoja.Name = "todas" Then hoja.Delete
    Next
    Sheets.Add before:=Sheets(1)
    ActiveSheet.Name = "todas"
    For x = 2 To Sheets.Count
        Sheets(x).Select
        Range("b10:g" & Range("a65000").End(xlUp).Row).Copy
        Sheets("todas").Range("a65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
        u1 = Sheets("todas").Range("G" & Rows.Count).End(xlUp).Row + 1
        u2 = Sheets("todas").Range("A" & Rows.Count).End(xlUp).Row
        Sheets("todas").Range("G" & u1 & ":G" & u2) = Sheets(x).Name
    Next
    Sheets("todas").Select
End Sub

sal u dos

Respuesta

Lo he hecho de memoria y sin probar (como en varias ocasiones) pero debería funcionar y/o en todo caso si la "ajustas" será, creo, como deseabas:

Sub ejemplo()
'por luismondelo
Dim x As Integer
Dim UltimaCelda As String
Application.DisplayAlerts = False
For Each hoja In ActiveWorkbook.Sheets
If hoja.Name = "todas" Then hoja.Delete
Next
Worksheets.Add(before:=Sheets(1)).Name = "todas"
For x = 2 To Sheets.Count
Sheets(x).Range("b10:g" & Range("a65000").End(xlUp).Row).Copy
Let UltimaCelda = Sheets("todas").Range("a65000").End(xlUp).Row + 1
Sheets("todas").Range("G" & UltimaCelda) = Sheets(x).Name
Sheets("todas").Range("A" & UltimaCelda).PasteSpecial Paste:=xlValues
Next
Sheets("todas").Select
End Sub

Comentas

Abraham Valencia

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas