Tabla excel resumen de otras
Tengo 2 tablas excel, ambas con las siguientes columnas: FECHA, CONCEPTO, DESCRIPCIÓN, ENTRADAS Y SALIDAS en hojas diferentes del mismo libro. Quiero que en otra hoja del mismo libro me vaya saliendo un RESUMEN SUMATORIO POR CONCEPTO, tanto de las entradas como de las salidas. O sea, esta tercera tabla debe tener 3 columnas:CONCEPTO, ENTRADAS Y SALIDAS. Me podéis decir, bien sea con macro o sin ella como hacerlo.
1 Respuesta
Si tus datos están como se muestra en la imagen
Te anexo la macro que deberás poner en los eventos de la "Hoja3"
Private Sub Worksheet_Activate()
'Por.Dante Amor
Application.ScreenUpdating = False
hojas = Array("Hoja1", "Hoja2")
Set h3 = Sheets("Hoja3")
'
u = h3.Range("A" & Rows.Count).End(xlUp).Row
If u < 2 Then u = 2
h3.Range("A2:C" & u).ClearContents
'
For j = 0 To 1
Set h = Sheets(hojas(j))
For i = 2 To h.Range("B" & Rows.Count).End(xlUp).Row
Set b = h3.Columns("A").Find(h.Cells(i, "B"), lookat:=xlWhole)
If b Is Nothing Then
u = h3.Range("A" & Rows.Count).End(xlUp).Row + 1
h3.Cells(u, "A") = h.Cells(i, "B")
h3.Cells(u, "B") = h.Cells(i, "D")
h3.Cells(u, "C") = h.Cells(i, "E")
Else
h3.Cells(b.Row, "B") = h3.Cells(b.Row, "B") + h.Cells(i, "D")
h3.Cells(b.Row, "C") = h3.Cells(b.Row, "C") + h.Cells(i, "E")
End If
Next
Next
End SubCambia en la macro los nombres "Hoja1", "Hoja2" y "Hoja3" por los nombres reales de tus hojas
Para poner la macro en los evento de la "hoja3"
Sigue las Instrucciones para poner la macro en worksheet
- Abre tu libro de excel
- Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
- Del lado izquierdo dice: VBAProject, abajo dale doble click a worksheet("Hoja3")
- Del lado derecho copia la macro
FUNCIONAMIENTO.
La macro funciona de la siguiente manera, tú podrás realizar todas las modificaciones a las hojas 1 y 2, podrás agregar nuevos conceptos, borrar, cambiar entradas, salidas, etc. Cuando selecciones la hoja3, en ese momento se activa la macro y realiza todo el resume, es decir, cada vez que te salgas de la hoja3 y vuelvas a entrar a la hoja3 se realizará el resumen de forma automática.
Tu respuesta se agradece pero te mando archivo adjunto para que te hagas una idea mejor gracias
No pusiste el archivo, habías comentado que el concepto estaba después de la fecha.
Entonces ahora no sé por cuál quieres el resumen.
Tampoco a parece en la imagen la fila en la que se encuentran las tablas.
Y por último podrías poner el resultado que esperas, ya que la última imagen está vacía.
Buenos días Dante, y muchísimas gracias de antemano.El resumen lo quiero por conceptos, que se vaya autorrellenando la tabla que está vacía, La fila de encabezados es la 2.
Aunque en esas imágenes no hay conceptos repetidos en las dos tablas en realidad si los hay, y quiero que en la tercera se sumen.un saludo
Sigue las Instrucciones para poner la macro en los eventos de worksheet
- Abre tu libro de excel
- Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
- Del lado izquierdo dice: VBAProject, abajo dale doble click a worksheet(Hoja3)
- Del lado derecho copia la macro
Recuerda cambiar en la macro "Hoja1", "Hoja2" y "Hoja3" por los nombres de tus hojas.
Esta es la macro
Private Sub Worksheet_Activate()
'Por.Dante Amor
Application.ScreenUpdating = False
hojas = Array("Hoja1", "Hoja2")
Set h3 = Sheets("Hoja3")
'
u = h3.Range("A" & Rows.Count).End(xlUp).Row
If u < 2 Then u = 2
h3.Range("A2:C" & u).ClearContents
'
For j = 0 To 1
Set h = Sheets(hojas(j))
For i = 4 To h.Range("C" & Rows.Count).End(xlUp).Row
Set b = h3.Columns("A").Find(h.Cells(i, "C"), lookat:=xlWhole)
If b Is Nothing Then
u = h3.Range("A" & Rows.Count).End(xlUp).Row + 1
h3.Cells(u, "A") = h.Cells(i, "C")
h3.Cells(u, "B") = h.Cells(i, "D")
h3.Cells(u, "C") = h.Cells(i, "E")
Else
h3.Cells(b.Row, "B") = h3.Cells(b.Row, "B") + h.Cells(i, "D")
h3.Cells(b.Row, "C") = h3.Cells(b.Row, "C") + h.Cells(i, "E")
End If
Next
Next
End SubSi tienes problemas para poner la macro avísame y la adapto a tu archivo.
Buenas tardes:Me da error de subíndice fuera de intervalo, si me la pudieras adaptar a mi hoja te lo agradecería, pero no se como adjuntarte el archivo excel un saludo
Tienes que cambiar las 3 hojas por "Hoja1" "Hoja2" y "Hoja3"
Ya se que le cambies el nombre a tus hojas o que en la macro cambies "Hoja1" "Hoja2" y "Hoja3" por los nombres de tus hojas.
Envíame tu archivo con todo y la macro
ya te lo envié
No me ha llegado, puedes revisar que hayas puesto bien mi correo
Te la he vuelto a enviar , a ver si esta vez te llega, gracias
Tal como te había comentado faltaba que pusieras el nombre de las hojas. Esta es la macro actualizada
Private Sub Worksheet_Activate()
'Por.Dante Amor
Application.ScreenUpdating = False
hojas = Array("A", "B")
Set h3 = Sheets("RESUMEN")
'
u = h3.Range("A" & Rows.Count).End(xlUp).Row
If u < 2 Then u = 2
h3.Range("A2:C" & u).ClearContents
'
For j = 0 To 1
Set h = Sheets(hojas(j))
For i = 4 To h.Range("C" & Rows.Count).End(xlUp).Row
Set b = h3.Columns("A").Find(h.Cells(i, "C"), lookat:=xlWhole)
If b Is Nothing Then
u = h3.Range("A" & Rows.Count).End(xlUp).Row + 1
h3.Cells(u, "A") = h.Cells(i, "C")
h3.Cells(u, "B") = h.Cells(i, "D")
h3.Cells(u, "C") = h.Cells(i, "E")
Else
h3.Cells(b.Row, "B") = h3.Cells(b.Row, "B") + h.Cells(i, "D")
h3.Cells(b.Row, "C") = h3.Cells(b.Row, "C") + h.Cells(i, "E")
End If
Next
Next
End SubSaludos.Dante Amor
Recuerda valorar la respuesta.
