Pivot Table - Paste Data Into New Sheet

[shahzeb]

Guys,

I am back.

I need your help now, I have data of 22k rows now I have used Pivot to sort the data.

I am using the below code where I filter the data this code will paste it into another sheet.

What I want to do is to that VBA code where it will filter the data automatically by column A when there is a total in column "A" aka RGM column

When there is a total it should copy this into another sheet with the name of as written in the last.

and it should do this with all the RGM column total

If any of you can help me so please do I am in dire need. I am here waiting for your response

VBA Code:
>>> use code - tags <<<

       Sub PivotCopyFormatValues()
'select pivot table cell first
Dim ws As Worksheet
Dim pt As PivotTable
Dim rngPT As Range
Dim rngPTa As Range
Dim rngCopy As Range
Dim rngCopy2 As Range
Dim lRowTop As Long
Dim lRowsPT As Long
Dim lRowPage As Long
Dim msgSpace As String

On Error Resume Next
Set pt = ActiveCell.PivotTable
Set rngPTa = pt.PageRange
On Error GoTo errHandler

If pt Is Nothing Then
    MsgBox "Could not copy pivot table for active cell"
    GoTo exitHandler
End If

If pt.PageFieldOrder = xlOverThenDown Then
  If pt.PageFields.Count > 1 Then
    msgSpace = "Horizontal filters with spaces." _
      & vbCrLf _
      & "Could not copy Filters formatting."
  End If
End If

Set rngPT = pt.TableRange1
lRowTop = rngPT.Rows(1).Row
lRowsPT = rngPT.Rows.Count
Set ws = Worksheets.Add
Set rngCopy = rngPT.Resize(lRowsPT - 1)
Set rngCopy2 = rngPT.Rows(lRowsPT)

rngCopy.Copy Destination:=ws.Cells(lRowTop, 1)
rngCopy2.Copy _
  Destination:=ws.Cells(lRowTop + lRowsPT - 1, 1)

If Not rngPTa Is Nothing Then
    lRowPage = rngPTa.Rows(1).Row
    rngPTa.Copy Destination:=ws.Cells(lRowPage, 1)
End If
  
ws.Columns.AutoFit
If msgSpace <> "" Then
  MsgBox msgSpace
End If

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not copy pivot table for active cell"
    Resume exitHandler
End Sub