Adaptación de Macro resumen

Hola Luis, quise hacer la adaptación como te había dicho pero como cosa rara no me salio bien. Lo que quiero es: La información esta en la hoja7 que se llama CtasxPagar2 y quiero el resultado de la macro en la hoja6 que se llama CtasxPagar, y otro dato que te aporto es que la información comienza en las celdas A8, B8, C8, D8, respectivamente.

Sub resumen()

Application.ScreenUpdating = False
Worksheets("CtasxPagar").Range("A:C").Clear
Worksheets("CtasxPagar2").Select
Range("B8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ActiveSheet.Next.Select
[A7] = "Proveedor"
[b7] = "Vencido"
[c7] = "Vencer"
[D7] = "Monto Acum. De Facturas"
Range("A8").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("A8:A").Select
ActiveSheet.Range("A8:A").RemoveDuplicates Columns:=1, Header:=xlNo
Range("A8").Select
'realiza suma
Dim b As Long
Dim v As Long
b = Application.WorksheetFunction.CountA(Worksheets("CtasxPagar2").Range("A8:A"))
v = Application.WorksheetFunction.CountA(Worksheets("CtasxPagar").Range("A8:A"))
If b Dim base As Range
Dim resumen As Range
For Each resumen In Worksheets("CtasxPagar").Range("A8:" & "A" & v)
For Each base In Worksheets("CtasxPagar2").Range("B8:" & "B" & b)
If resumen = base And base.Offset(0, -1) < Date Then
resumen.Offset(0, 1) = resumen.Offset(0, 1) + base.Offset(0, 1)
If resumen = base And base.Offset(0, -1) >= Date Then
resumen.Offset(0, 2) = resumen.Offset(0, 2) + base.Offset(0, 1)
Next (Aquí presenta el error)
Next
Set base = Nothing
Set resumen = Nothing
Application.ScreenUpdating = True
MsgBox "Resumen Completado", vbInformation

End Sub

así lo adapte pero me sale error de que "Next sin For", se lo quito en brinca al próximo Next y también lo quito y brinca al End Sub. Disculpa tanta ignorancia. Saludos.

Respuesta
1

Prueba ahora

Sub resumen()
'4c7569735f50
Application.ScreenUpdating = False
Worksheets("CtasxPagar").Range("A:D").Clear
Worksheets("CtasxPagar2").Select
Range("B8").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Worksheets("CtasxPagar").Select
[A7] = "Proveedor"
[b7] = "Vencido"
[c7] = "Vencer"
[D7] = "Monto Acum. de Facturas"
Range("A8").Select
ActiveSheet.Paste
Application.CutCopyMode = False
[a8].Select
Range(Selection, Selection.End(xlDown)).Select
Selection.RemoveDuplicates Columns:=1, Header:=xlNo
Range("A8").Select
'realiza suma
Dim b As Long
Dim v As Long
b = Application.WorksheetFunction.CountA(Worksheets("CtasxPagar2").Range("A8:A65535")) + 7
v = Application.WorksheetFunction.CountA(Worksheets("CtasxPagar").Range("A8:A65535")) + 7
If b <= 1 Then Application.ScreenUpdating = True: Exit Sub
Dim base As Range
Dim resumen As Range
For Each resumen In Worksheets("CtasxPagar").Range("A8:" & "A" & v)
For Each base In Worksheets("CtasxPagar2").Range("B8:" & "B" & b)
If resumen = base And base.Offset(0, -1) < Date Then _
resumen.Offset(0, 1) = resumen.Offset(0, 1) + base.Offset(0, 1)
If resumen = base And base.Offset(0, -1) >= Date Then _
resumen.Offset(0, 2) = resumen.Offset(0, 2) + base.Offset(0, 1)
Next
Next
Set base = Nothing
Set resumen = Nothing
Application.ScreenUpdating = True
MsgBox "Resumen Completado", vbInformation
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas