If your data is laid out like I think it is, then this should work. Try it
and if it doesn't, let me know.

Sub InsertTotals()
Dim DataArray(500, 5) As Variant
Dim DataArray2(500, 2) As Variant
Dim Cumulator2 As Long
Dim x As Long
Dim Y As Long
Dim LastRow As Long
Dim Cumulators As Long
Dim FString As String
Dim Found As Integer
Dim TheType As String

Range("A65000").End(xlUp).Select 'this is a row with data, this row +1 is
empty!
Let LastRow = ActiveCell.Row
x = 1
Let Cumulator2 = 0
Do While True
If x LastRow Then
Exit Do
End If
If x = 11 Then
'Beep
End If
If Cells(x, 1).Value < Empty Then
Let Cumulators = 0
End If
If Cells(x, 1).Value = "Customer" Then
ElseIf Cells(x, 2).Value Like "*Sum of Sale*" Then
If Cells(x, 2).Value Like "*Sale*" Then
Let TheType = "Sales"
Else
Let TheType = "Vol"
End If
Let FString = "="
Range("E" & x).Select
Let Found = 0
For Y = 1 To Cumulators
If DataArray(Y, 2) = TheType Then
If Found = 1 Then
Let FString = FString & "+R[" & -(x - DataArray(Y, 1)) &
"]C"
Else
Let FString = FString & "R[" & -(x - DataArray(Y, 1)) &
"]C"
Found = 1
End If
End If
Next
ActiveCell.FormulaR1C1 = FString
Range("E" & x).Select
Selection.Copy
Range("E" & x + 1).Select
ActiveSheet.Paste
Range("E" & x).Select

Selection.Copy
Range("F" & x).Select
ActiveSheet.Paste
Selection.Copy
Range("F" & x + 1).Select
ActiveSheet.Paste

Selection.Copy
Range("G" & x).Select
ActiveSheet.Paste
Selection.Copy
Range("G" & x + 1).Select
ActiveSheet.Paste
Let Cumulators = 0
Let Cumulator2 = Cumulator2 + 1
DataArray2(Cumulator2, 1) = x

'ElseIf Cells(x, 2).Value Like "*Sum of svolum*" Then



ElseIf Cells(x, 4).Value = "Sales" Then
Let Cumulators = Cumulators + 1
DataArray(Cumulators, 1) = x
DataArray(Cumulators, 2) = "Sales"
ElseIf Cells(x, 4).Value = "Vol" Then
Let Cumulators = Cumulators + 1
DataArray(Cumulators, 1) = x
DataArray(Cumulators, 2) = "Vol"
ElseIf Cells(x, 1).Value Like "*Sum of Sale*" Then
Let FString = "="
For Y = 1 To Cumulator2
Let FString = FString & "+R[" & -(x - DataArray2(Y, 1)) & "]C"
Next
Cells(x, 5).Select
ActiveCell.FormulaR1C1 = FString
Selection.Copy
Range("E" & x + 1).Select
ActiveSheet.Paste
Range("E" & x).Select

Selection.Copy
Range("F" & x).Select
ActiveSheet.Paste
Selection.Copy
Range("F" & x + 1).Select
ActiveSheet.Paste

Selection.Copy
Range("G" & x).Select
ActiveSheet.Paste
Selection.Copy
Range("G" & x + 1).Select
ActiveSheet.Paste
cumulators2 = 0
End If
x = x + 1
Loop


End Sub