Suma cantidades de un rango variable y pega en otra hoja
Quiero plantearles la siguiente cuestión
Parto de un Excel con dos hojas visible en pantalla Hoja1 y Hoja2. Con datos variables.
Lo que necesito es una macro que automáticamente haga la suma de los rangos
De forma que en la Hoja1 Celda C1 ponga la suma del rango variable según valor de Hoja1 celda A1
Igualmente en C2 Hoja1 pondría el resultado de la suma de todas las filas con valor Hoja1 celda A2
E igual con el resto
Marco en color para aclarar un poco mas la duda
Muchas gracias
Disculpa Isaac Reyes que te haga mención pero es continuación a una duda que rápidamente me resolviste
Pregunta : Filtrar datos en Hoja2 según posición celda Hoja1
´
2 Respuestas
Valorar la respuesta saludos!
Prueba la macro
Sub Sumar_C()
'
'Por.Adriel Ortiz
'
'
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
h2.Cells.Clear
h1.Columns("A").Copy h2.Columns("A")
'
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
h2.Range("A1:A" & u2).RemoveDuplicates Columns:=1, Header:=xlNo
'
With h2.Range("C1:C" & h2.Range("A" & Rows.Count).End(xlUp).Row)
.FormulaR1C1 = "=SUMIF(Hoja1!RC[-2]:R[15]C[-2],Hoja2!RC[-2],Hoja1!RC[3]:R[15]C[3])"
.Value = .Value
End With
'
Application.ScreenUpdating = True
MsgBox "fin"
End Sub
El resultado te pondrá en la hoja2 lo adecuas a tus necesidades
Gracias Adriel, pero no que hago mal, me borra todos los datos de Hoja2
Adjunto Excel
https://ydray.com/get/l/Eib0NjM0MT57163717MTE4/DkNTcxNjM3593Rp
Gracias
Te paso la macro actualizada, espero tus comentarios
Sub Sumar_C()
'
'Por.Adriel Ortiz
'
'
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja2")
Set h2 = Sheets("Hoja1")
h2.Cells.Clear
h1.Columns("A").Copy h2.Columns("A")
'
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
h2.Range("A1:A" & u2).RemoveDuplicates Columns:=1, Header:=xlNo
'
With h2.Range("C1:C" & h2.Range("A" & Rows.Count).End(xlUp).Row)
.FormulaR1C1 = "=SUMIF(Hoja2!RC[-2]:R[15]C[-2],Hoja1!RC[-2],Hoja2!RC[3])"
.Value = .Value
End With
'
Application.ScreenUpdating = True
MsgBox "fin"
End Sub
Prueba con esta macro
Sub sumar_rangos()
Set h2 = Worksheets("hoja1")
Set h1 = Worksheets("hoja2")
filas = h1.Range("A" & Rows.Count).End(xlUp).Row
cuenta_llenos = WorksheetFunction.CountA(h1.Range("a:a"))
vacios = filas - cuenta_llenos + 1
For i = 1 To vacios
If i = 1 Then Set datos = h1.Range("a1").CurrentRegion
If i > 1 Then
filas = datos.Rows.Count
Set datos = datos.Rows(filas + 2).CurrentRegion
End If
suma = WorksheetFunction.Sum(datos.Columns(6))
With h2
.Range("a1").Cells(i, 1) = datos.Cells(1, 1)
.Range("a1").Cells(i, 3) = suma
End With
Next i
Set datos = Nothing
End Sub