Copy filtered pivot table data to new sheets instead of new workbooks

[Martin sherk]

I've come so far in my project and it all depends on solving my last issue, the below code helps me create a Pivot table for all my customers based on company code, so it filters company code criteria in the pivot table and then copies the filtered data to new workbooks named after the company code.

All I need is that instead of copying data to the new workbook, I want it to be copied to the current workbook (the workbook with the pivot table on), just adding new sheets named after the company code and copy the filtered data in it.

Wish someone would help me with this, I would be so thnakful.

My code:

Option Explicit
Sub GetAllEmployeeSelections()

    'Const filePath As String = "C:\Users\User\Desktop\" 'save location for new files

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim pvt As PivotTable


    Set wb = ActiveWorkbook
    Set ws = wb.Worksheets("PivotTable")
    Set pvt = ws.PivotTables("PivotTable1")
pvt.PivotCache.MissingItemsLimit = xlMissingItemsNone

    Application.ScreenUpdating = False

    Dim pvtField As PivotField
    Dim item As Long
    Dim item2 As Long

    Set pvtField = pvt.PivotFields("Company Code")

    For item = 1 To pvtField.PivotItems.Count

          pvtField.PivotItems(item).Visible = True

          For item2 = 1 To pvtField.PivotItems.Count

              If item2 <> item Then pvtField.PivotItems(item2).Visible = False

          Next item2

        Dim newBook As Workbook
        Set newBook = Workbooks.Add

        With newBook

            Dim currentName As String
            currentName = pvtField.PivotItems(item).Name

            .Worksheets(1).Name = currentName

            pvt.TableRange2.Copy

            Worksheets(currentName).Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

        End With

    Next item

    Application.ScreenUpdating = True

End Sub

 

[Alex Blakenburg]

The code you have is already very close. Try this:

Sub GetAllEmployeeSelections_CopyToSheet()

    'Const filePath As String = "C:\Users\User\Desktop\" 'save location for new files

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim pvt As PivotTable


    Set wb = ActiveWorkbook
    Set ws = wb.Worksheets("PivotTable")
    Set pvt = ws.PivotTables("PivotTable1")
pvt.PivotCache.MissingItemsLimit = xlMissingItemsNone

    Application.ScreenUpdating = False

    Dim pvtField As PivotField
    Dim item As Long
    Dim item2 As Long

    Set pvtField = pvt.PivotFields("Company Code")

    For item = 1 To pvtField.PivotItems.Count

          pvtField.PivotItems(item).Visible = True

          For item2 = 1 To pvtField.PivotItems.Count

              If item2 <> item Then pvtField.PivotItems(item2).Visible = False

          Next item2
         
        ' Changed section to copy to new sheet in current workbook
        Dim currentName As String
        Dim newSheet As Worksheet
        currentName = pvtField.PivotItems(item).Name
        
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = currentName
        Set newSheet = ActiveSheet

        pvt.TableRange2.Copy

        newSheet.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

    Next item

    Application.ScreenUpdating = True

End Sub

 

[Martin sherk]

The code you have is already very close. Try this:

Sub GetAllEmployeeSelections_CopyToSheet()

    'Const filePath As String = "C:\Users\User\Desktop\" 'save location for new files

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim pvt As PivotTable


    Set wb = ActiveWorkbook
    Set ws = wb.Worksheets("PivotTable")
    Set pvt = ws.PivotTables("PivotTable1")
pvt.PivotCache.MissingItemsLimit = xlMissingItemsNone

    Application.ScreenUpdating = False

    Dim pvtField As PivotField
    Dim item As Long
    Dim item2 As Long

    Set pvtField = pvt.PivotFields("Company Code")

    For item = 1 To pvtField.PivotItems.Count

          pvtField.PivotItems(item).Visible = True

          For item2 = 1 To pvtField.PivotItems.Count

              If item2 <> item Then pvtField.PivotItems(item2).Visible = False

          Next item2
        
        ' Changed section to copy to new sheet in current workbook
        Dim currentName As String
        Dim newSheet As Worksheet
        currentName = pvtField.PivotItems(item).Name
       
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = currentName
        Set newSheet = ActiveSheet

        pvt.TableRange2.Copy

        newSheet.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

    Next item

    Application.ScreenUpdating = True

End Sub

Fantastic ! worked flawlesly. one more question please, it copies the data without the pivot. how can I copy the pivot table itself as it is?

 

[Alex Blakenburg]

Sure just know that if you copy the entire pivot table each Company Sheet has "all" the pivot data behind it and can be switched to view any company.

To make the change make the code replacement shown below:

'        pvt.TableRange2.Copy
'        newSheet.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

        pvt.TableRange2.Copy Destination:=newSheet.Range("A1")

If you have company as a page filter you can even achieve that without using VBA. The function is called "Show Report Filter Pages"
Create Multiple Pivot Table Reports with Show Report Filter Pages - Excel Campus

Under the Tab - Pivot Table Analyze > PivotTable > Options > Show Report Filter Pages

 

[Martin sherk]

Sure just know that if you copy the entire pivot table each Company Sheet has "all" the pivot data behind it and can be switched to view any company.

To make the change make the code replacement shown below:

'        pvt.TableRange2.Copy
'        newSheet.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats

        pvt.TableRange2.Copy Destination:=newSheet.Range("A1")

If you have company as a page filter you can even achieve that without using VBA. The function is called "Show Report Filter Pages"
Create Multiple Pivot Table Reports with Show Report Filter Pages - Excel Campus

Under the Tab - Pivot Table Analyze > PivotTable > Options > Show Report Filter Pages

Didn't know that i can do that! added to my noted, thanks alot !

 

[Martin sherk]

@Alex Blakenburg may I use your expertise and ask you one last question? in my sheet now i have 3 sheets for each company code (i know each sheet name).
can i copy all the content of these 3 sheets to a new workbook and save it with a specific name in my mind.

Thanks again man for taking the time answering my questions.

 

[Alex Blakenburg]

Of course but assuming you got the code from somewhere, isn't that what it was doing before we started modifying it ?
Also is it a New Workbook for each company or does the new workbook have all companies ?

 

[Martin sherk]

Of course but assuming you got the code from somewhere, isn't that what it was doing before we started modifying it ?
Also is it a New Workbook for each company or does the new workbook have all companies ?

Yes sir, new workbook for each company code.

 

[Alex Blakenburg]

How are you going to tell the macro where you want to save it to ?
Also like I said earlier, if you will give each company a copy of the actual pivot like you requested, you will be giving each company access to all the companies data.

 

[Martin sherk]

How are you going to tell the macro where you want to save it to ?
Also like I said earlier, if you will give each company a copy of the actual pivot like you requested, you will be giving each company access to all the companies data.

let me elaobrate more on my situation, so for each company code i have 3 sheets, 1 with all their payments, 1 for specific customers, and lastly a sheet with PVT for that specific company code

it looks like the screenshot attached, so i want to copy those 3 sheets (USA1, USA1 Distributors, USA PVT) to a new workbook and name that workbook USA1 Payment then save it and close it.

Save it in downloads file for example, i will change that in the code.

pelase note that i have 7 company codes, each with 3 sheets also ( USA1, USA2 and so on).

I hope i was able to explain myself well.