Split worksheet into multiples and add subtotals to each WS

I have this macro that splits one worksheet into multiple worksheets based upon content from Column A.
Does anyone know how to add subtotals to each worksheet either using this formula or by some other method that will work (other than actually going into each worksheet to do so).

Sub Split_Worksheets()
Dim rRange As Range, rCell As Range
Dim wSheet As Worksheet
Dim wSheetStart As Worksheet
Dim strText As String

 Set wSheetStart = ActiveSheet
 wSheetStart.AutoFilterMode = False
 'Set a range variable to the correct item column
 Set rRange = Range("A1", Range("A65536").End(xlUp))

     'Delete any sheet called "UniqueList"
     'Turn off run time errors & delete alert
     On Error Resume Next
     Application.DisplayAlerts = False
     Worksheets("UniqueList").Delete

     'Add a sheet called "UniqueList"
     Worksheets.Add().Name = "UniqueList"

        'Filter the Set range so only a unique list is created
         With Worksheets("UniqueList")
              rRange.AdvancedFilter xlFilterCopy, , _
              Worksheets("UniqueList").Range("A1"), True

              'Set a range variable to the unique list, less the heading.
              Set rRange = .Range("A2", .Range("A65536").End(xlUp))
         End With

         On Error Resume Next
         With wSheetStart
             For Each rCell In rRange
               strText = rCell
               .Range("A1").AutoFilter 1, strText
                 Worksheets(strText).Delete
                 'Add a sheet named as content of rCell
                 Worksheets.Add().Name = strText
                 'Copy the visible filtered range _
                 (default of Copy Method) and leave hidden rows
                 .UsedRange.Copy Destination:=ActiveSheet.Range("A1")
                 ActiveSheet.Cells.Columns.AutoFit
             Next rCell
         End With

     With wSheetStart
         .AutoFilterMode = False
         .Activate
     End With

     On Error GoTo 0
     Application.DisplayAlerts = True
End Sub

Thank you

look right after you autofit the data, and the code is there

Sub Split_Worksheets()
Dim rRange As Range, rCell As Range
Dim wSheet As Worksheet
Dim wSheetStart As Worksheet
Dim strText As String

 Set wSheetStart = ActiveSheet
 wSheetStart.AutoFilterMode = False
 'Set a range variable to the correct item column
 Set rRange = Range("A1", Range("A65536").End(xlUp))

     'Delete any sheet called "UniqueList"
     'Turn off run time errors & delete alert
     On Error Resume Next
     Application.DisplayAlerts = False
     Worksheets("UniqueList").Delete

     'Add a sheet called "UniqueList"
     Worksheets.Add().Name = "UniqueList"

        'Filter the Set range so only a unique list is created
         With Worksheets("UniqueList")
              rRange.AdvancedFilter xlFilterCopy, , _
              Worksheets("UniqueList").Range("A1"), True

              'Set a range variable to the unique list, less the heading.
              Set rRange = .Range("A2", .Range("A65536").End(xlUp))
         End With

         On Error Resume Next
         With wSheetStart
             For Each rCell In rRange
               strText = rCell
               .Range("A1").AutoFilter 1, strText
                 Worksheets(strText).Delete
                 'Add a sheet named as content of rCell
                 Worksheets.Add().Name = strText
                 'Copy the visible filtered range _
                 (default of Copy Method) and leave hidden rows
                 .UsedRange.Copy Destination:=ActiveSheet.Range("A1")
                 ActiveSheet.Cells.Columns.AutoFit
                 Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(4), _
                 Replace:=True, PageBreaks:=False, SummaryBelowData:=True
             Next rCell
         End With

     With wSheetStart
         .AutoFilterMode = False
         .Activate
     End With

     On Error GoTo 0
     Application.DisplayAlerts = True
End Sub

That completely worked, and blew my mind! That was awesome to see it work!

Thank you!