PIVOT FILTER - PASTE INTO NEW SHEET

[shahzeb123]

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

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

 

[GlennUK]

Why don't you just put RGM in the table filter area, then use Ribbon Command Pivottable/Options/Show Report Filter Pages - it will generate the sheets automatically?

 

[shahzeb123]

That is a really good option! I really liked that.

However, the issue is I need to share the data with everyone so I can not share the pivot report that is why I was using my code which copy-paste (values & format) the data into other sheets.

Now, I have made progress I did have a code that will copy-paste all the filtered data into new sheets.

But what I want is to copy-paste the data in new worksheets with their filtered specific names.

Sub Button2_Click()
 
Dim PT As PivotTable
Dim PI As PivotItem
Dim PI2 As PivotItem
 
'1)Worksheet name where PIVOT Table is located
MyWs = "SUMMARY"
'2)PIVOT table name/number, note by default the first one created is PivotTable1
MyPIV = "PivotTable1"
'3)Field Name that you want to use for breaking out by, i.e. the filter name
MyField = "RGM"
 
Set PT = Worksheets(MyWs).PivotTables(MyPIV)
With PT
 
For Each PI In Worksheets(MyWs).PivotTables(MyPIV).PivotFields(MyField).PivotItems
PI.Visible = True
 
For Each PI2 In Worksheets(MyWs).PivotTables(MyPIV).PivotFields(MyField).PivotItems
If Not PI2.Name = PI.Name Then PI2.Visible = False
Next PI2


 
'You will need to amend the range below to copy the correct amount of data for your file
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)
ws.Name = PI

rngCopy.Copy Destination:=ws.Cells(lRowTop, 1)
rngCopy2.Copy _
  Destination:=ws.Cells(lRowTop + lRowsPT - 1, 1)
ws.Columns.AutoFit
 
'This pastes into cell A1 of the new sheet

Next PI
End With
End Sub

 

[shahzeb123]

Please don't judge me with the code as I am new to this so I have made my code my joining multiple other codes.

and if something I added which is not needed so you can tell me, please.

 

[GlennUK]

But my method can be used, and then all the sheets generated can be visited, and the UsedRange per sheet copied and pasted as values. Doesn't that make the macro very simple?

 

[shahzeb123]

SIr,

I need to share the data with all RGM and there are total of 57 RGM in the data with your method it will make sheets and then I will need to copy paste every RGM into different worksheet and save the file by changing name.

and I need to do that every month.

with your method it will take a lot of time for me.

that's why I am trying to do that with Macros

 

[GlennUK]

My method will not take a lot of time if you automate it with macros. The macros will be simpler that what you are attempting - do you see?

 

[shahzeb123]

Sir ,

I understand now , so can you share the code so i can use it and understand it.

 

[shahzeb123]

What i am after is all filtered data get into new workbooks with values and formats.

And get saved by the name of filtered RGM name

and saved into defined path.

 

[GlennUK]

Sir ,

I understand now , so can you share the code so i can use it and understand it.

I will try to find some time for this tonight. But, hopefully, someone else has the time to look at this - I am very busy right now.