Looping Through Workbook and making pivot tables on each worksheet

[rzacek87]

I have looked at other solutions and am close to having code working. However the code does not loop to the next sheet:

Sub CreateAPivotTable()


    Dim shtSource As Worksheet
    Dim rngSource As Range, rngDest As Range
    Dim pvt As PivotTable

    For Each shtSource In ActiveWorkbook.Worksheets
        If shtSource.Name <> "Original" Then

        On Error GoTo ErrHandler


        Application.ScreenUpdating = False



        Set shtSource = ActiveSheet


        Set rngSource = shtSource.Range("A1").CurrentRegion


        Set rngDest = ActiveSheet.Range("P1")


        Set pvt = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngSource, _
        Version:=xlPivotTableVersion12).CreatePivotTable(TableDestination:=rngDest, DefaultVersion:=xlPivotTableVersion12)

        pvt.AddDataField pvt.PivotFields("Policy #"), "Count of Policy #", xlCount


        With pvt.PivotFields("Policy #")
            .Orientation = xlRowField
            .Position = 1
        End With


        pvt.TableStyle2 = "PivotStyleDark7"
        With Cells.Font
            .Name = "Calibri"
            .Size = 8
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ThemeColor = xlThemeColorLight1
            .TintAndShade = 0
            .ThemeFont = xlThemeFontMinor
        End With

        ActiveWorkbook.ShowPivotTableFieldList = False
  
        End If
    Next shtSource


    Application.ScreenUpdating = True

    Exit Sub

    ErrHandler:
    Application.ScreenUpdating = True
    MsgBox "An error occurred: " & Err.Description, vbExclamation, "Error"


End Sub

 

[RoryA]

Remove:

Set shtSource = ActiveSheet

 

[rzacek87]

Remove:

Set shtSource = ActiveSheet

Sadly that didnt help and now the code is running on the sheet named Original when it shouldnt be (bangs head)

 

[RoryA]

If the pivots are supposed to be on each sheet too, then this:

Set rngDest = ActiveSheet.Range("P1")

should be:

Set rngDest = shtSource.Range("P1")

 

[rzacek87]

If the pivots are supposed to be on each sheet too, then this:

Set rngDest = ActiveSheet.Range("P1")

should be:

Set rngDest = shtSource.Range("P1")

That took care of both issues now.
Thanks.