Recopilar datos específicos de todas las hojas
Les presento mi problemática a ver si alguien me puede ayudar para realizar una macro.
Tengo al rededor de 100 hojas en un libro, son una especie de recibo de pago, quisiera que la información de los "activos"(earnings) y "pasivos"(expenses) de cada hoja se pudieran compilar en una sola hoja, a continuación les explico con capturas:
Los elementos que a mi me gustaría recopilar en una hoja nueva a manera de lista seria: NOMBRE, ACTIVO y PASIVO de cada una de estas hojas.
Y que se reunan en una hoja de esta manera:
La cuestión es que las hojas de las que quiero recopilar información siempre tienen diferente nombre pero los valores que yo quiero siempre se encuentran en la celda E2, D27 y H27, que se junten en una hoja a manera de lista en este caso en la hoja llamada OVERALL.
¿Alguien podría darme asesoría con esto por favor? Si entiendo un poco el código y podría ajustarlo a mis necesidades si necesito hacer cambios.
2 Respuestas
La macro que ocupas es similar a esta, recorre todas las páginas y almacena en una matriz los valores de las celdas e2, d27 y h27 de cada una de las hojas (excepto overall) en una matriz que luego descarga en la página overall.
Sub recolectar_datos()
Set HD = Worksheets("overall")
CUENTA = Worksheets.Count - 1
TITULOS = Array("NOMBRE", "ACTIVO", "PASIVO")
Set DESTINO = HD.Range("a2").Resize(CUENTA, 3)
MATRIZ = DESTINO
X = 1
For Each hoja In Worksheets
NOMBRE = hoja.Name
If NOMBRE = "OVERALL" Then GoTo SIGUIENTE
MATRIZ(X, 1) = Worksheets(NOMBRE).Range("E2")
MATRIZ(X, 2) = Worksheets(NOMBRE).Range("D27")
MATRIZ(X, 3) = Worksheets(NOMBRE).Range("H27")
X = X + 1
If X > CUENTA Then Exit For
SIGUIENTE:
Next hoja
With DESTINO
HD.Range(.Address) = MATRIZ
.Rows(0) = TITULOS
.Rows(0).Font.Bold = True
.EntireColumn.AutoFit
End With
End Sub
Tal vez existan hojas que no quieras recopilar, en tal caso podrías utilizar la siguiente macro.
Solamente cambia o agrega las hojas que no quieras recopilar en la siguiente línea:
Case "OVERALL", "ORIGINAL", "OVERWRITES", "DATA"
La macro:
Sub Recopilar_Info()
'Por.Dante Amor
Set h1 = Sheets("OVERALL")
h1.Rows("2:" & Rows.Count).ClearContents
fila = 2
For Each h In Sheets
Select Case UCase(h.Name)
Case "OVERALL", "ORIGINAL", "OVERWRITES", "DATA"
Case Else
h1.Range("A" & fila & ":C" & fila) = Array(h.[E2], h.[D27], h.[H27])
fila = fila + 1
End Select
Next
MsgBox "Fin"
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.