Calcular Total de ingresos Excel VBA

Para Dante.

Continuando como la pregunta anterior:

Macro para insertar filas y sumar valores excel Vba

Deseo agregar el (total de ingresos) al final de la hoja del archivo creado y que no considere la columna F

1 respuesta

Respuesta
2

Te anexo la macro actualizada

Sub InsertarTotales()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Pagos")
    h1.Copy
    Set l2 = ActiveWorkbook
    Set h2 = l2.Sheets(1)
    '
    h2.Columns("F").Delete
    u = h2.Range("A" & Rows.Count).End(xlUp).Row
    With h2.Sort
        .SortFields.Clear
        .SortFields.Add Key:=h2.Range("C4:C" & u), SortOn:=xlSortOnValues, _
            Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange h2.Range("A3:E" & u)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    wtotal = WorksheetFunction.Sum(h2.Range("E2:E" & u))
    '
    c1 = "B"    'columna de nombres
    c2 = "E"    'columna de importes
    u = h2.Range(c1 & Rows.Count).End(xlUp).Row
    fin = u
    ant = h2.Cells(u, c1)
    tot = 0
    For i = u To 3 Step -1
        If h2.Cells(i, c1) <> ant Then
            h2.Rows(fin + 1 & ":" & fin + 2).Insert
            h2.Cells(fin + 1, c2) = tot
            tot = 0
            fin = i
        End If
        tot = tot + Val(h2.Cells(i, c2))
        ant = h2.Cells(i, c1)
    Next
    u = h2.Range("E" & Rows.Count).End(xlUp).Row + 2
    h2.Cells(u, "E") = wtotal
    ruta = l1.Path & "\"
    l2.SaveAs ruta & "totales.xlsx", FileFormat:=xlOpenXMLWorkbook
    l2.Close
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub

 sal u dos

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas