Hi I need a little help with this macro I've been working on. Some of it is from ctrl key macros that I have recorded and a little help from the forum. I ultimately need to get this macro to work across all the sheets in the work book. But only one portion of it works across all the worksheets. And I've been getting the following error. This portion worked on it's own, but combined with all the macros together as one wont!

ActiveWorkbook.Worksheets.AutoFilter.Sort.SortFields.Clear – Runtime error 91 object variable or with block variable not set


 
Public Sub Test()
    
    
    Dim WS  As Worksheet
    Dim R   As Long
 
    On Error GoTo EndMacro
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    For Each WS In Worksheets
        With WS.UsedRange
            For R = .Rows.Count To 1 Step -1
                If Application.WorksheetFunction.CountA(.Rows(R).EntireRow) = 0 Then
                    .Rows(R).EntireRow.Delete
                End If
            Next R
        End With
    Next WS
    
EndMacro:
  
     
      ' unmergenew Macro
 
    Application.Goto Reference:="R1C1"
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.UnMerge
        
' filtersort Macro
 
'
    Application.Goto Reference:="R8C1"
    Rows("8:8").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets.AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets.AutoFilter.Sort.SortFields.Add Key:=_Range("D8"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _ 
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet22").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
 
'Remove head count data macro
 
 
    Cells.Find(What:="actual:", After:=ActiveCell, LookIn:=xlFormulas, lookat _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Rows.Select
    Selection.Delete Shift:=xlUp
 
'Remergeonly Macro
 
    Columns("A:C").Select
    Selection.Merge True
    Columns("K:L").Select
    Selection.Merge True
    Application.Goto Reference:="R1C16"
    Selection.Copy
    Application.Goto Reference:="R3C7"
    ActiveSheet.Paste
    Range("G1:J3").Select
    Application.CutCopyMode = False
    Selection.Merge True
    Range("F1:J3").Select
    Selection.Merge True
    Range("F3:J3").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Columns("O:P").Select
    Selection.Merge True
     
ActiveWorkbook.Sheets.Select
 
' Merges data from all the selected worksheets onto the end of the
' active worksheet.
 
Const NHR = 1
Dim MWS As Worksheet
Dim AWS As Worksheet
Dim FAR As Long
Dim LR As Long
Set AWS = ActiveSheet
 
For Each MWS In ActiveWindow.SelectedSheets
If Not MWS Is AWS Then
FAR = AWS.UsedRange.Cells(AWS.UsedRange.Cells.Count).Row + 1
LR = MWS.UsedRange.Cells(MWS.UsedRange.Cells.Count).Row
MWS.Range(MWS.Rows(NHR + 1), MWS.Rows(LR)).Copy AWS.Rows(FAR)
End If
Next MWS
 
 ActiveSheet.PageSetup.PrintArea = "$A$1:$R$100"
    ActiveWindow.SmallScroll Down:=2900
   ActiveSheet.PageSetup.PrintArea = "$A$1:$Q$3000"
   
 
    Dim FoundCell As Range
    Dim FirstAddress As String
    Dim PrevAddress As String
    Dim CurrAddress As String
    Dim SearchTerm As String
 
    SearchTerm = "Manning Check Report"
 
    With Columns("G:K")
        Set FoundCell = .Find(SearchTerm, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
        If Not FoundCell Is Nothing Then
            FoundCell.Name = "FirstAddress"
            Do
                PrevAddress = FoundCell.Address
                FoundCell.Resize(3).EntireRow.Insert
                ActiveSheet.HPageBreaks.Add before:=Range(PrevAddress)
                Set FoundCell = .FindNext(FoundCell)
            Loop While FoundCell.Address <> Range("FirstAddress").Address
        Else
            MsgBox "No search term found...", vbExclamation
        End If
    End With
  Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
        
 
 
End Sub
Any help would be greatly appreciated
Thanx
MZING81