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.
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 SubComentas
Abraham Valencia
1 respuesta más de otro experto
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 Subsal u dos