Ver resultado de varias hojas en una. AYUDA !
Hola expertos. Tengo 15 hoja y necesito hacer una hoja de resumen copiando el valor de las celdas B2:B78 de cada una de la hojas o sea 15 hojas a la hoja resumen, de la siguiente forma (en la hoja resumen) : en la columna B deben ir los datos de la primer hoja, en la columna C los datos de la segunda hoja, en la columna DE los datos de la tercer hoja y así hasta la hoja 15. Luego se debe sumar los datos de forma horizontal de cada una de la filas en una fila resumen.
1 Respuesta
Respuesta de excelinomano
1
Aquí esta el código que puedes utilizar para hacer lo que quieres:
Sub conjuntar()
Dim hoja As Worksheet
Application.DisplayAlerts = False
For Each hoja In Worksheets
If hoja.Name = "Resumen" Then
hoja.Delete
End If
Next hoja
Application.DisplayAlerts = True
Sheets.Add
ActiveSheet.Name = "Resumen"
contar = 1
For Each hoja In Worksheets
If hoja.Name <> "Resumen" Then
hoja.Select
Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Resumen").Select
Range("A2").Select
ActiveCell.Offset(0, contar).Select
ActiveSheet.Paste
Application.CutCopyMode = False
contar = 1 + contar
End If
Next hoja
Sheets("Resumen").Select
Range("B2").Select
While ActiveCell.Value <> ""
Inicial = ActiveCell.Address
Selection.End(xlToRight).Select
Final = ActiveCell.Address
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "=sum(" & Inicial & ":" & Final & ")"
Selection.End(xlToLeft).Select
ActiveCell.Offset(1, 0).Select
Wend
End Sub
Por favor no olvides calificar y cerrar la pregunta
Sub conjuntar()
Dim hoja As Worksheet
Application.DisplayAlerts = False
For Each hoja In Worksheets
If hoja.Name = "Resumen" Then
hoja.Delete
End If
Next hoja
Application.DisplayAlerts = True
Sheets.Add
ActiveSheet.Name = "Resumen"
contar = 1
For Each hoja In Worksheets
If hoja.Name <> "Resumen" Then
hoja.Select
Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Resumen").Select
Range("A2").Select
ActiveCell.Offset(0, contar).Select
ActiveSheet.Paste
Application.CutCopyMode = False
contar = 1 + contar
End If
Next hoja
Sheets("Resumen").Select
Range("B2").Select
While ActiveCell.Value <> ""
Inicial = ActiveCell.Address
Selection.End(xlToRight).Select
Final = ActiveCell.Address
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "=sum(" & Inicial & ":" & Final & ")"
Selection.End(xlToLeft).Select
ActiveCell.Offset(1, 0).Select
Wend
End Sub
Por favor no olvides calificar y cerrar la pregunta
