subtotal on page break

[shaqil]

Dear All,

i have a sheet which has a lot of entries, I want to automatic page
break after every 20 entries and need a sum of that 20 entries on
every page break. this sum should be brought forward on next page and
including the next sum on next page break.

Is it possible thru VBA.

Thnx in advance

 

[Guest]

Sub addbreaks()
Done = False
LastTotal = 1
RowCount = 1
For Count = 1 To (RowCount + 20)
RowCount = Count
If IsEmpty(Cells(Count, "B")) Then
Done = True
Exit For
End If
Next Count

Do
Cells(RowCount, "B").EntireRow.Insert
Cells(RowCount, "A") = "Subtotal"
If LastTotal = 1 Then
Cells(RowCount, "B").Formula = "=sum(B" & LastTotal & _
":B" & (RowCount - 1) & ")"
Else
Cells(RowCount, "B").Formula = "=sum(B" & LastTotal & _
":B" & (RowCount - 1) & ") + B" & (LastTotal - 1)
End If
ActiveWindow.SelectedSheets.HPageBreaks.Add _
Before:=Cells(RowCount + 1, "B")
LastTotal = RowCount + 1

'get next row
For Count = LastTotal To (LastTotal + 20)
If IsEmpty(Cells(Count, "B")) Then
Done = True
Exit For
End If
Next Count
RowCount = Count
Loop While Done = False

If RowCount <> LastRow Then
Cells(RowCount, "B").EntireRow.Insert
Cells(RowCount, "A") = "Subtotal"
If LastTotal = 1 Then
Cells(RowCount, "B").Formula = "=sum(B" & LastTotal & _
":B" & (RowCount - 1) & ")"
Else
Cells(RowCount, "B").Formula = "=sum(B" & LastTotal & _
":B" & (RowCount - 1) & ") + B" & (LastTotal - 1)
End If
ActiveWindow.SelectedSheets.HPageBreaks.Add _
Before:=Cells(RowCount + 1, "B")
End If

End Sub