Give this a try
Add this code to a module in your workbook and then run it.
Change
YourExcelFileNameHere.xls to the name of you Excel File
and
ExcelTabWithPivotTable to the tab name thatg holds your pivot table
Sub DoItAll()
Dim rng As Range, strTabName As String, intTabNum As Integer,
curLocation As String
strTabName = ""
intTabNum = 0
curLocation = ""
Range("D5").Select
Range(Selection, Selection.End(xlDown)).Select
For Each rng In Selection
If rng.Offset(0, -1) <> "Grand Total" Then
intTabNum = intTabNum + 1
curLocation = ActiveCell.Address
strTabName = ActiveCell.Offset(0, -3)
Selection.ShowDetail = True
Sheets("Sheet" & intTabNum).Select
Sheets("Sheet" & intTabNum).Name = strTabName
Worksheets(strTabName).Copy
Windows("YourExcelFileNameHere.xls").Activate
strTabName = ""
Sheets("ExcelTabWithPivotTable").Select
Range(curLocation).Offset(1, 0).Select
End If
'Sheets(strTabName).Move
Next rng
End Sub