VBA to save new files based on worksheets

[Access Beginner]

Hi Guys,

I have a workbook which will use the Show Report Filter as pages option for a pivot table to create 16 sheets based on the filter. I also have another worksheet called "Cover Page".

What I would like (if possible) is to create 16 new files ( xlsx format) based on the 16 sheets, but to also include the "Cover Page" in these newly created files.

The 16 sheets names will change depending on which filter I apply in the pivot table. But I can change the the names of the code when needed, if soemone can supply it in the 1st instance.

Any help is greatly appreciated, as I have to create these reports based on new data each week.


Using Excel 2007

Cheers

 

[Jerry Sullivan]

Hi Access Beginner,

Here is an example to get you started...

Sub Report_and_Summary_Sheet()
    Dim i As Integer, sItem As String
    Dim ptItem As PivotItem, wbMain As Workbook
    Dim arrItems As Variant
    Application.ScreenUpdating = False
    On Error Resume Next
    
    arrItems = Split("Smith;Greene;Jones;Anderson;Li;" & _
                        "Brown;Wilson;Perez", ";")
   
    Set wbMain = ActiveWorkbook
    With ActiveSheet.PivotTables("PivotTable1")
        With .PivotFields("Department Managers")
            If .EnableMultiplePageItems = True Then
                .ClearAllFilters
            End If
            For i = 0 To UBound(arrItems)
                 sItem = arrItems(i)
                 Set ptItem = .PivotItems(sItem)
                 'test item exists or .CurrentPage will be renamed
                 If Not ptItem Is Nothing Then
                     .CurrentPage = sItem
                     ActiveSheet.Copy 'copies PT Report sheet to New Book
                     With ActiveWorkbook
                         wbMain.Sheets("Cover Page").Copy Before:=.Sheets(1)
                         .SaveAs "C:\TEST\MyReport-" & sItem & ".xlsx", _
                             FileFormat:=xlOpenXMLWorkbook
                         .Close
                     End With
                 End If
             Next i
        End With
    End With
End Sub

 

[Access Beginner]

Thanks Jerry,

I'll test it out tomorrow at work.

Your assistance is much appreciated.

Cheers
Haydn

 

[Jerry Sullivan]

My pleasure Haydn.

Just let me know if you need any help adapting the example to your application.

 

[Access Beginner]

Hi Jerry,

Can I get some advice on your code please? I've had a crack and these are some of the changes I have made.

 arrItems = Split("Smith;Greene;Jones;Anderson;Li;" & _
                        "Brown;Wilson;Perez", ";")

This is where I guess I input the 16 sheet names that I want to create files from. My names will be Zone 1 xxxxx, Zone 2xxxx etc

With .PivotFields("Department Managers")

Change this to ("Zone"), as that is what I am filtering by

With ActiveSheet.PivotTables("PivotTable1")

Change this to my PivotTable name PivotTable19?

.SaveAs "C:\TEST\MyReport-" & sItem & ".xlsx", _

And finally I think, change this to the path to where I want to save my files?

I've done all of the above, but no success.

I dont imagine that I've got it right, so any furher advice would be great.
Cheers
Haydn

 

[Jerry Sullivan]

Haydn,

Can you post your revised code in it's entirety?
Chances are that it's a minor syntax error or typo- probably in the statement to create the array of Zones.

 

[Jerry Sullivan]

BTW, It's probably clearer to use Array() than Split() like this....

   arrItems = Array("Zone 1 XXX", "Zone 2 XXX", "Zone 3 XXX", _
                     "Zone 4 XXX", "Zone 5 XXX", "Zone 6 XXX")

I tend to use Split because I'm lazy and don't like typing all those " "

 

[Access Beginner]

Hi again Jerry,

Thanks for responding, here is my attempt.

Sub Report_and_Summary_Sheet()
    Dim i As Integer, sItem As String
    Dim ptItem As PivotItem, wbMain As Workbook
    Dim arrItems As Variant
    Application.ScreenUpdating = False
    On Error Resume Next
    
    arrItems = Split("Zone 10 Southern QLD;Zone 1 Midcoast NSW;Zone 11 Border Ranges;Zone 12 Pacific Coast;Zone 16 Northern Australia;" & _
                        "Zone 13 South Australia;Zone 14 Sydney;Zone 15 Northern QLD", ";")
   
    Set wbMain = ActiveWorkbook
    With ActiveSheet.PivotTables("PivotTable19")
        With .PivotFields("Zone")
            If .EnableMultiplePageItems = True Then
                .ClearAllFilters
            End If
            For i = 0 To UBound(arrItems)
                 sItem = arrItems(i)
                 Set ptItem = .PivotItems(sItem)
                 'test item exists or .CurrentPage will be renamed
                 If Not ptItem Is Nothing Then
                     .CurrentPage = sItem
                     ActiveSheet.Copy 'copies PT Report sheet to New Book
                     With ActiveWorkbook
                         wbMain.Sheets("Cover Page").Copy Before:=.Sheets(1)
                         .SaveAs "C:\Data-" & sItem & ".xlsx", _
                             FileFormat:=xlOpenXMLWorkbook
                         .Close
                     End With
                 End If
             Next i
        End With
    End With
End Sub

 

[Jerry Sullivan]

What folder do you want to copy your reports to?

This part of the statement will save them directly under C:\

.SaveAs "C:\Data-" & sItem & ".xlsx", _
   FileFormat:=xlOpenXMLWorkbook

as:
Data-Zone 10 Southern QLD.xlsx
Data-Zone 1 Midcoast NSW.xlsx
'...etc.

If you want to put them in folder C:\Data\
as:
Zone 10 Southern QLD.xlsx
Zone 1 Midcoast NSW.xlsx

...change to:

.SaveAs "C:\Data\" & sItem & ".xlsx", _
    FileFormat:=xlOpenXMLWorkbook

If that wasn't the problem, please explain what happens when you try to run the code?

 

[Access Beginner]

Thanks Jerry,

Changed SaveAs "C:\Data- to SaveAs "C:\Data\

and it is working perfectly.

You help and advice is greatly appreciated.

Cheers
Haydn