Copy a pivot table using VBA from Access

[duanecwilson]

I have created a pivot table successfully using the Excel object model from VBA in Access. I need 2 more copies of this pivot table on the SAME sheet with 2 different "pages" selected.

So far, I have Dim xla as Excel.Application, xlw as Excel.Workbook, and xls as Excel.Worksheet and used these references in my code successfully. But they don't work when I attempt to Select -> Select Entire Table (this part works, actually), but when I attempt to use xls.copy or even activesheet.copy and xls.paste or activesheet.paste, it goes through the code, but nothing happens. The pivot table is still selected through this whole process.

Why is it that I can do it physically by hand, but when I try to use the recorded macro code or a VBA variation of it, it won't copy and paste. This is a minor issue with serious consequences. I must figure out how to do this. Any help will be gratefully apprecitated. Here's some code:

Public Sub CreateMainPivot()
    On Error GoTo Except
    Set xls = xla.Worksheets.Add(After:=xlw.Worksheets(xlw.Worksheets.Count))
    xls.Name = "GeneralManager"
    xlw.Sheets("GeneralManager").Select
    Set xls = xlw.Sheets("GeneralManager")
    With xlw.PivotCaches.Add(SourceType:=xlExternal)
        .Connection = Array(Array("ODBC;DSN=MS Access Database;DBQ=D:\Users\501599284\My Documents\EED Actuals Reports.mdb;DefaultDir=" & _
        "D:\Users\501599284\My Documents;D"), Array("riverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;"))
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT Query8MakeTable.GeneralManager, Query8MakeTable.EmployeeType, Query8MakeTable.PandL, ", _
        "Query8MakeTable.Platform, Query8MakeTable.FunctionalManager, Query8MakeTable.ProgramType, Query8MakeTable.Pl", _
        "atformDetail, Query8MakeTable.SHOP_ORDER, Query8MakeTable.ACTIVITY_NUMBER, Query8MakeTable.EMPLOYEE_NAME, Query8MakeTable.FW, ", _
        "Query8MakeTable.HOUR_TYPE, Query8MakeTable.LaborRate, Query8MakeTable.Hours, ", _
        "Query8MakeTable.Cost, Query8MakeTable.Function" & Chr(13) & "" & Chr(10) & _
        "FROM `D:\Users\501599284\My Documents\EED Actuals Reports`.Query8MakeTable Query8MakeTable" & Chr(13) & "" & Chr(10) & _
        "ORDER BY Query8MakeTable.GeneralManager, Query8MakeTable." & _
        "EmployeeType, Query8MakeTable.PandL, Query8MakeTable.Platform, Query8MakeTable.FW")
        .CreatePivotTable TableDestination:="", TableName:="DataPivot"
    End With
'    xlw.PivotCaches.Add(xlDatabase, "'GeneralManager'!R1C1:R" & irow & "C" & icol).CreatePivotTable _
'        TableDestination:="", TableName:="DataPivot"
    Set xls = xlw.ActiveSheet
    xls.Name = "2008 Pivot"
    xls.PivotTableWizard TableDestination:=xls.Cells(3, 1)
    xls.Cells(3, 1).Select
    xls.PivotTables("DataPivot").SmallGrid = False
    With xls.PivotTables("DataPivot").PivotFields("EmployeeType")
        .Orientation = xlPageField
    End With
    With xls.PivotTables("DataPivot").PivotFields("GeneralManager")
        .Orientation = xlPageField
    End With
    With xls.PivotTables("DataPivot").PivotFields("PandL")
        .Orientation = xlRowField
        .Position = 1
    End With
    With xls.PivotTables("DataPivot").PivotFields("Platform")
        .Orientation = xlRowField
        .Position = 2
    End With
    xls.PivotTables("DataPivot").PivotFields("FW").Orientation = xlColumnField
    xls.PivotTables("DataPivot").PivotFields("Cost").Orientation = xlDataField
    xls.PivotTables("DataPivot").PivotFields("Count of Cost").Function = xlSum
    xls.PivotTables("DataPivot").Format xlTable1
    xls.Columns("C:" & GetColumn(xls.Cells.SpecialCells(xlCellTypeLastCell).Column)).NumberFormat = "$#,##0.00"
    xls.Columns("A:" & GetColumn(xls.Cells.SpecialCells(xlCellTypeLastCell).Column)).AutoFit
    'Save the created workbook.
    xlw.SaveAs Replace(Trim(Str(Format(Date, "yyyymmdd")) & "Test" & Str(Format(Time(), "hhmmss")) & ".xls"), " ", "")
    '---------------------------------------
    [b]' Code to copy and paste would go here.:[/b]
    '
    '---------------------------------------
    xla.Visible = True
    xla.UserControl = True
    Stop
    xlw.Close
    xla.Quit
    Exit Sub
Exit Sub
Except:
    Call DisplayError(Err, "CreateMainPivot")
End Sub

Duane Wilson

 

[PHV]

Code to copy and paste would go here
What have you tried that didn't work ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886