VBA To automatically insert subtotals in multiple worksheets

Good Day, I hope somebody can help me, I have an workbook with a main sheet ""2017 Sales" and 10 worksheets with the name of each individual sales Agents, I have a macro that pulled all the information of the each sales Agents as I required, but I need sub totals to show as well on each sales persons worksheet, cant seem to get a macro to work so that I can see subtotals ????
This is the Current Code I have to pull the agents info from main sheet, I need to edit this so that it can pull subtotals as well under my Columns for each individual agent

Sub agents()
Dim ws As Worksheet
Dim wsNew As Worksheet
Dim rData As Range
Dim rCl As Range
Dim sNm As String
Set ws = Sheet1

'extract a list of unique names
'first clear existing list
With ws
Set rData = .Range("A1").CurrentRegion
.Columns(.Columns.Count).Clear
rData.Columns(6).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True

For Each rCl In .Cells(1, .Columns.Count).CurrentRegion
sNm = rCl.Text
'add new sheet (only if required-NB uses UDF)
If WksExists(sNm) Then
Sheets(sNm).Cells.Clear
Else
'new sheet required
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count) 'move to end
wsNew.Name = sNm
End If
'AutoFilter & copy to relevant sheet
rData.AutoFilter Field:=6, Criteria1:=sNm
rData.Copy Destination:=Worksheets(sNm).Cells(1, 1)
Next rCl
End With
ws.Columns(Columns.Count).ClearContents 'remove temporary list
rData.AutoFilter 'switch off AutoFilter

End Sub

Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function



Regards
Vicky