Run time error when running macro to populate a pivot table

[Pete Straman Straman via OfficeKB.com]

Hey!

I run the following macro to process a pivot table. It works fine the first
time it is run. After I complete it and want to build another one it gives
a run time error.
I have to exit excel completely and reopen it in Book1 to get it to run all
the way thru. The problem codes are surrounded by ******
I want to be able to run it on the active work sheet no matter want file is
open. I have tried creating worksheets at the begining and the PivotCache
will not run at all.
I also want the "Select Database" from CreatePivotTables to go to specified
directory not the default if possible.

Sub Macro_Testing()

'
' Create_Pivot_Table Macro
' Macro recorded 2/19/2005 by Pete Straman
'
' Keyboard Shortcut: Ctrl+Shift+T

'Tried this stuff to if deleting a sheet and adding it would help run time
error on second time thru program

' Delete PivotSheet if it exists
'On Error Resume Next
'Application.DisplayAlerts = False
'Sheets("Sheet1").Delete
'On Error GoTo 0

' Add new worksheet
'Worksheets.Add
'ActiveSheet.Name = "Sheet1"

With ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)
.Connection = "ODBC;DSN=MS Access Database;"
.CommandType = xlCmdSql
.CommandText = "SELECT trend_rpt.facilityid, trend_rpt.`Sum of
Revenue`," _
+ " trend_rpt.`Sum of Payments`, trend_rpt.`Sum of Adjustments`,
trend_rpt.transmoyr," _
+ " trend_rpt.dosmoyr" & Chr(13) & "" & Chr(10) & "FROM trend_rpt
trend_rpt" _

' *************************How do I set this to a specified directory?
****************
' *****************tried at .Connection without success

.CreatePivotTable TableDestination:="Sheet1!R1C1", TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion10

'************************************************************************************
End With

ActiveSheet.PivotTables("PivotTable1").ColumnGrand = False
ActiveSheet.PivotTables("PivotTable1").AddFields RowFields:="dosmoyr", _
PageFields:="facilityid"
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Sum of
Revenue")
.Orientation = xlDataField
.Caption = "Revenue"
.NumberFormat = "$#,##0.00_);($#,##0.00)"
End With
Range("A5:A65").Select

Selection.Sort Order1:=xlAscending, Type:=xlSortLabels, OrderCustom:=6,
_
Orientation:=xlTopToBottom

With ActiveSheet.PivotTables(1).PivotFields("facilityid")
.CurrentPage = .PivotItems(1).Value
End With

Columns("A:B").Select
Selection.Copy
Range("C1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.PivotTableWizard TableDestination:="Sheet1!R1C3"



'******* This statement will cause a runtime error used in
'******* anything but Book1 - so I have to close and reopen excel to
get it to run
' Run time error 1004 unable to get the Pivot Tables property of the
worksheet class

ActiveSheet.PivotTables("PivotTable2").AddFields RowFields:="dosmoyr", _
ColumnFields:="transmoyr", PageFields:="facilityid"

'*********************************************************************************
'*********************************************************************************

With ActiveSheet.PivotTables(2).PivotFields("facilityid")
.CurrentPage = .PivotItems(1).Value
End With

ActiveSheet.PivotTables("PivotTable2").PivotFields("Revenue")
..Orientation = _
xlHidden
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Sum of
Payments")
.Orientation = xlDataField
.Caption = "Payments"
.NumberFormat = "$#,##0.00_);($#,##0.00)"
End With
ActiveSheet.PivotTables("PivotTable2").DataPivotField.PivotItems
("Payments"). _
Position = 1
Columns("C:C").Select
Selection.EntireColumn.Hidden = True


Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Pivot Table"
Sheets("Pivot Table").Select
Sheets("Pivot Table").Copy Before:=Sheets(1)
Sheets("Pivot Table (2)").Select
Sheets("Pivot Table (2)").Name = "Collections"
Cells.Select
Selection.Copy
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Sheets("Collections").Select
Application.CutCopyMode = False
Sheets("Collections").Move Before:=Sheets(3)
Sheets("Pivot Table").Select

End Sub