sum cells above every blank cell

[parscon]

Hello i have this VBA code but it will sum in and put the value in the latest blank cell i need sum and paste the value in top blank cell like the the attached images

Sub SumAreas()

Dim Area As Range
For Each Area In Range("G1", Range("G" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
  With Area
    Cells(.Row + .Rows.Count, 7).Value = Evaluate("=Sum(G" & .Row & ":G" & .Row + .Rows.Count - 1 & ")")
    Cells(.Row + .Rows.Count, 7).Font.Bold = True
  End With
Next Area
End Sub

Result.jpg

[hkho]

is there have worksheet function call "sumif" can fulfill your request?

[parscon]

Sorry I do not understand what your mean ?

[mana]

Sub test()
    Dim a As Range
    
    For Each a In Columns(7).SpecialCells(xlCellTypeConstants).Areas
        With a(1).Offset(-1)
            .Value = WorksheetFunction.Sum(a)
            .Font.Bold = True
        End With
    Next
    
End Sub

マナ

[YasserKhalil]

Hello Try this code

Sub SumAreasTest()
    Dim area As Range
    
    For Each area In Range("G1", Range("G" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
        With area
            Cells(.Row - 1, 7).Value = Evaluate("=Sum(G" & .Row & ":G" & .Row + .Rows.Count - 1 & ")")
            Cells(.Row - 1, 7).Font.Bold = True
        End With
    Next area
End Sub

[parscon]

Appreciate for your help .