Macro with sum function

[RobRem]

I am trying to write a macro that will sum a set numbers that are a part of a
column. I have inserted empty rows to use as breaks for the Ctl+down or
END.Down commands to define the range. I then use the Sum button to total
the selection and then I cut and paste the value over to new column. When I
run the macro it does not place the sum in the cell and cuts and pastes the
last cell in the range.
Any ideas?
below is the code for the macro.

ActiveCell.Offset(-1, 0).Range("A1").Select
Selection.End(xlToLeft).Select
Selection.End(xlDown).Select
Selection.EntireRow.Insert
Selection.End(xlUp).Select
ActiveCell.Offset(0, 9).Range("A1").Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveCell.Range("A1:A7").Select
ActiveCell.Offset(6, 0).Range("A1").Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-6]C:R[-1]C)"
ActiveCell.Offset(-6, 0).Range("A1:A7").Select
Selection.End(xlDown).Select
Selection.Cut
ActiveCell.Offset(0, 3).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(0, -3).Range("A1").Select
Selection.End(xlDown).Select
End Sub

 

[Sheeloo]

With blank rows between numbers try
(this will insert the SUM in the blank cells in Col A
If you want them in any other col then change A in
Cells(lastrow, "A").Offset(1, 0).Formula = "=SUM(A" & firstrow & ":A" &
lastrow & ")"
to the col you want

macro:

Sub insertSUM()
With ActiveSheet
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Do While (lastrow > 1)
firstrow = .Cells(lastrow, "A").End(xlUp).Row
Cells(lastrow, "A").Offset(1, 0).Formula = "=SUM(A" & firstrow & ":A" &
lastrow & ")"
If lastrow > 2 Then
lastrow = firstrow - 2
End If
Loop
End With
End Sub