Skip Pivot Values if Account is not available and paste in template file

Viewed 23
Option Explicit
    
    Sub Account_Name()
        
        Workbooks.Open "C:\Reports\Book1.xlsm"
        Workbooks.Open "C:\Reports\Book2.xlsx"
        Workbooks.Open "C:\Reports\Book3.xlsx"
        Workbooks.Open "C:\Reports\Book4.xlsx"
    
        Dim workbookNames As Variant
        workbookNames = Array("Book1.xlsm", "Book2.xlsx", "Book3.xlsx", "Book4.xlsx")
        
        Dim i As Long
        For i = LBound(workbookNames) To UBound(workbookNames)
            
            Dim wb As Workbook
            Set wb = Workbooks(workbookNames(i))
            
            Dim ws As Worksheet
            Set ws = wb.Worksheets("Pivot")
            
            Dim rootAccount As String
            Dim rootAccount1 As String
            rootAccount = ws.Cells(1, 6).Value  'SELECT ROOT ACCOUNT NAMES FROM DROP DOWN MENU
            rootAccount1 = ws.Cells(1, 7).Value 'ALL
                        
            On Error GoTo msg
                
            Dim pt As PivotTable
            For Each pt In ws.PivotTables
                With pt
                    With .PivotFields("Root Account")
                        .ClearAllFilters
                        .CurrentPage = rootAccount
                    End With
                End With
                Next pt
        Next i
        
        Workbooks("Book1").Activate
        
Done:
            Exit Sub
            
msg:
            MsgBox "Root Account not available, please create this report manually"
                      
            For Each pt In ws.PivotTables
                With pt
                    With .PivotFields("Root Account")
                        .ClearAllFilters
                        .CurrentPage = rootAccount1
                    End With
                End With
                Next pt

       Workbooks("Book1").Activate

End Sub


Sub Create_Report()

Dim Bk1 As Workbook
Dim Bk2 As Workbook
Dim Bk3 As Workbook
Dim Bk4 As Workbook
Dim Temp As Workbook
Dim fname As String
Dim Path As String

Application.DisplayAlerts = False

Set Bk1 = Workbooks.Open("C:\Reports\Book1.xlsm")
Set Bk2 = Workbooks.Open("C:\Reports\Book2.xlsx")
Set Bk3 = Workbooks.Open("C:\Reports\Book3.xlsx")
Set Bk4 = Workbooks.Open("C:\Reports\Book4.xlsx")
Set Temp = Workbooks.Open("C:\Reports\Template.xlsm")

        
Bk1.Sheets("Pivot").Range("A10:M68").Copy
Temp.Sheets("Data").Range("B4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False

Bk2.Sheets("Pivot").Range("B10:L10").Copy
Temp.Sheets("Data").Range("Y22").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False

Bk3.Sheets("Pivot").Range("B8:H8").Copy
Temp.Sheets("Data").Range("AC37").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False

Bk4.Sheets("Pivot").Range("B5:M5").Copy
Temp.Sheets("Data").Range("X16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False

Temp.Activate

Sheets("PPT").Activate

ActiveWorkbook.RefreshAll

Path = "C:\Reports\"
fname = Range("B1") & ".xlsm"

ActiveWorkbook.SaveAs Filename:=Path & fname

ActiveWorkbook.Worksheets("PPT").Activate

Application.Run "'" & Temp.Name & "'!CopyToPowerPoint"

Application.DisplayAlerts = True

Workbooks("Book1").Activate

Sheets("Pivot").Activate

End Sub

I've this code to change pivot field (Root Account) in 4 different workbooks and give error if Root Account is missing in any of the 4 workbooks. If Root Account is available in all workbooks, it copies the data and paste in the Template file.

Is it possible to copy those data also where Root Account is not available, for e.g. Root Account is available in 3 workbooks and not available in 4th one, it gives error, is it possible paste 3 workbooks data in Template file and skip 4th one. "TIA"

0 Answers
Related