extra rows in subtotal

[bobvilla]

On my spreadsheet, I have a macro that updates a query on the page then performs a subtotal to average the results.
The problem I'm having is that on the last subtotal, it inserts a whole bunch of extra rows between the last row of data and the actual subtotal. On the last one in particular, it inserted over 38,000 blank rows.
What am I doing wrong and how do I fix it?

 

[mirabeau]

Could you post your macro code?

 

[bobvilla]

Here is the macro code. The part in red relates to the sheet with the subtotals

' TM Macro
' Macro recorded 8/13/2010 by
'
'
Sheets("TM1").Select
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A1").Select
Selection.QueryTable.Refresh BackgroundQuery:=False
Columns("D:D").Select
Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="/", FieldInfo:=Array(1, 5), TrailingMinusNumbers:=True
Columns("E:E").Select
Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="/", FieldInfo:=Array(1, 5), TrailingMinusNumbers:=True
Columns("D:E").Select
Columns("D:E").EntireColumn.AutoFit
Columns("A:A").Select
Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Columns( _
"A:A"), CopyToRange:=Range("T1"), Unique:=True
ActiveWindow.SmallScroll ToRight:=9
Range("V2:X2").Select
Selection.AutoFill Destination:=Range("V2:X2500"), Type:=xlFillDefault
Range("V2:X2500").Select
Range("A1").Select
Sheets("TM2").Select
Range("A1").Select
Selection.QueryTable.Refresh BackgroundQuery:=False
Columns("A:M").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("A2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
Selection.Subtotal GroupBy:=1, Function:=xlAverage, TotalList:=Array(6), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Range("N2:P2").Select
Selection.AutoFill Destination:=Range("N2:P15000"), Type:=xlFillDefault
Range("N2:P15000").Select
Sheets("TM MINPAY").Select
Range("A8:F8").Select
Selection.AutoFill Destination:=Range("A8:F2500"), Type:=xlFillDefault
Range("A8:F2500").Select
Range("H8").Select
Selection.AutoFill Destination:=Range("H8:H2500"), Type:=xlFillDefault
Range("H8:H2500").Select
Range("A1").Select
End Sub