Ok Everyone,

You have helped this novice before, and I have been searching through the forum for some time now to find how to do this. Basically as an accountant for a school I run a TON of queries that have a variety of information. There are mutiple fund sources involved and I need to move all but one source to the bottom (insert lines to seperate the top source from the rest). I am in need of some code that will find the other sources, cut them, and paste them at the bottom. The tricky part is that every query has a variety of rows so I never know what the last row is. Below is some code that I obtained from a previous accountant and from the record macro function, but it only moves the "STATE" source to the bottom and there are still a handful of sources that remain and need to be moved. Any advice would be appreciated. Also if any changes to the current code can be simplified please let me know.

Sub Example()
'
' Example Macro
'
' Keyboard Shortcut: Ctrl+Shift+C
'
    'Asking for the Sheet name of the workbook to avoid errors
    sheetName = InputBox("Please enter the name (case-sensitive) of" & Chr(10) & "the first sheet in the workbook (e.g. Sheet1): ")
    
    'Deleting the first row and also checking for errors in the sheetName variable before any action is taken
    Worksheets(sheetName).Activate
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    
    'Changing Font to Times New Roman
    Cells.Select
    With Selection.Font
        .Name = "Times New Roman"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    
    'Fitting all the columns
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
    Columns("G:G").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Columns("I:I").EntireColumn.AutoFit
    Columns("J:J").EntireColumn.AutoFit
    Columns("K:K").EntireColumn.AutoFit
    Columns("L:L").EntireColumn.AutoFit
    Columns("M:M").EntireColumn.AutoFit
    Columns("N:N").EntireColumn.AutoFit
    Columns("O:O").EntireColumn.AutoFit
    Columns("P:P").EntireColumn.AutoFit
    Columns("Q:Q").EntireColumn.AutoFit
    Columns("R:R").EntireColumn.AutoFit
    Columns("S:S").EntireColumn.AutoFit
    Columns("T:T").EntireColumn.AutoFit
    
    'This sorts all the data by "Fund" (Column E) "Bud Cat" (Column D) and by "Date" (Column B)
    ActiveWorkbook.Worksheets(sheetName).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(sheetName).Sort.SortFields.Add Key:=Range("E2:E10000") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(sheetName).Sort.SortFields.Add Key:=Range("D2:D10000") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(sheetName).Sort.SortFields.Add Key:=Range("B2:B10000") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(sheetName).Sort
        .SetRange Range("A1:U10000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    'This finds where the State section starts and adds rows above it
    Range("E1").Select
    For i = 1 To 10000
        ActiveCell.Offset(1, 0).Select
        If ActiveCell.Value = "STATE" Then Exit For
    Next i
    
    'Adding rows
    Rows(ActiveCell.Row).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    
    'This copies the first row and pastes it above the "State" section
    Rows("1:1").Select
    Selection.Copy
    
    Range("E1").Select
    For i = 1 To 10000
        ActiveCell.Offset(1, 0).Select
        If ActiveCell.Value = "STATE" Then Exit For
    Next i
    
    Rows(ActiveCell.Row).Offset(-1, 0).Select
    ActiveSheet.Paste    
    Range("A2").Select
    Selection.Subtotal GroupBy:=4, Function:=xlSum, TotalList:=Array(20), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    ActiveSheet.Outline.ShowLevels RowLevels:=2
    ActiveWindow.SmallScroll Down:=-21
    ActiveCell.Offset(28, 4).Range("A1").Select
    
    'Finally, this puts a comma in the S Column
    Range("T1:T10000").Select
    Selection.style = "Comma"
    
    'Just selecting the first cell in the workbook to end on
    Range("A1").Select
    
End Sub