OMG_VBA_IS_GREAT
Technical User
Hi All,
I am struggling to get the following code to work. I want to create a pivot table using from two spreadsheets that have same column headers. Unfortunately, the macro fails. Any help or advise would be greatly appreciated.
Sub CreatePivot()
Dim i As Long
Dim arSQL() As String
Dim objPivotCache As PivotCache
Dim objRS As Object
Dim wbkNew As Workbook
Dim wks As Worksheet
With ActiveWorkbook
ReDim arSQL(1 To 2)
For Each wks In .Worksheets
i = i + 1
arSQL(i) = "SELECT * FROM [" & wks.Name & "!" & "A1:U10000]"
Next wks
Set wks = Nothing
Set objRS = CreateObject("ADODB.Recordset")
objRS.Open Join$(arSQL, " UNION ALL "), Join$(Array("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=", _
.FullName, ";Extended Properties=""Excel 8.0;"""), vbNullString)
End With
Set wbkNew = Workbooks.Add(Template:=xlWBATWorksheet)
With wbkNew
Set objPivotCache = .PivotCaches.Add(xlExternal)
Set objPivotCache.Recordset = objRS
Set objRS = Nothing
With .Worksheets("Pivot")
objPivotCache.CreatePivotTable TableDestination:=.Range("A3")
Set objPivotCache = Nothing
End With
End With
Set wbkNew = Nothing
End Sub
I am struggling to get the following code to work. I want to create a pivot table using from two spreadsheets that have same column headers. Unfortunately, the macro fails. Any help or advise would be greatly appreciated.
Sub CreatePivot()
Dim i As Long
Dim arSQL() As String
Dim objPivotCache As PivotCache
Dim objRS As Object
Dim wbkNew As Workbook
Dim wks As Worksheet
With ActiveWorkbook
ReDim arSQL(1 To 2)
For Each wks In .Worksheets
i = i + 1
arSQL(i) = "SELECT * FROM [" & wks.Name & "!" & "A1:U10000]"
Next wks
Set wks = Nothing
Set objRS = CreateObject("ADODB.Recordset")
objRS.Open Join$(arSQL, " UNION ALL "), Join$(Array("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=", _
.FullName, ";Extended Properties=""Excel 8.0;"""), vbNullString)
End With
Set wbkNew = Workbooks.Add(Template:=xlWBATWorksheet)
With wbkNew
Set objPivotCache = .PivotCaches.Add(xlExternal)
Set objPivotCache.Recordset = objRS
Set objRS = Nothing
With .Worksheets("Pivot")
objPivotCache.CreatePivotTable TableDestination:=.Range("A3")
Set objPivotCache = Nothing
End With
End With
Set wbkNew = Nothing
End Sub