Export Access Table to Excel Workbook and then Create Pivot Table In Excel

If you have table in Ms Access and want to export its data to excel and then create a pivot table in Ms Excel. For Example-

Access Table



Pivot Table in Excel




Here is the code-

Option Compare Database

Private Sub Command0_Click()
Dim abc As New Excel.Application
Dim wbk As Excel.Workbook
Dim WKS As Excel.Worksheet
Dim S As String
Dim rst As DAO.Recordset
Dim fld As Field
Dim i As Integer
i = 1
abc.Visible = False
abc.ScreenUpdating = False
abc.DisplayAlerts = False


Set wbk = abc.Workbooks.Add
Set WKS = wbk.Worksheets.Add
WKS.Name = "Data"
'**************** delete empty sheets"
wbk.Sheets("Sheet1").Delete
wbk.Sheets("Sheet2").Delete
wbk.Sheets("Sheet3").Delete
'*********************** copy header of table**************************
Set rst = CurrentDb.OpenRecordset("select * from abc", dbOpenSnapshot)
abc.Visible = True
abc.ScreenUpdating = False
abc.DisplayAlerts = False
'******************** adding header to excel worksheet

For Each fld In rst.Fields
WKS.Cells(1, i).Value = fld.Name
WKS.Cells(1, i).Interior.Color = vbCyan
WKS.Cells(1, i).Font.Bold = True
i = i + 1
Next fld
rst.MoveFirst
'************************ copy the data from access to excel
WKS.Range("A2").CopyFromRecordset rst

'**************************** creating pivot
wbk.Sheets.Add After:=wbk.Sheets(wbk.Sheets.Count)
wbk.Sheets(wbk.Sheets.Count).Name = "Pivot Table 2"

wbk.Sheets("Data").Select
' selecting the source data in sheet name data
wbk.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
wbk.Sheets("Data").Range("a1:d" & wbk.Sheets("Data").Range("a65356").End(xlUp).Row)).CreatePivotTable TableDestination:=wbk.Sheets("Pivot Table 2").Cells(1, 1), _
TableName:="PivotTable1"
wbk.Sheets("Pivot Table 2").Select
With wbk.Sheets("Pivot Table 2").PivotTables("PivotTable1").PivotFields("Name")
.Orientation = xlRowField
.Position = 1
End With
With wbk.Sheets("Pivot Table 2").PivotTables("PivotTable1").PivotFields("Product")
.Orientation = xlRowField
.Position = 2
End With
With wbk.Sheets("Pivot Table 2").PivotTables("PivotTable1").PivotFields("Region")
.Orientation = xlColumnField
.Position = 1
End With
wbk.Sheets("Pivot Table 2").PivotTables("PivotTable1").AddDataField wbk.Sheets("Pivot Table 2").PivotTables( _
"PivotTable1").PivotFields("Sales"), "Sum of Sales", xlSum
'************ hide subtotal
wbk.Sheets("Pivot Table 2").PivotTables("PivotTable1").PivotFields("Name").Subtotals(1) = False
wbk.ShowPivotTableFieldList = False
wbk.Sheets("Pivot Table 2").PivotTables("PivotTable1").TableStyle2 = "PivotStyleDark16"
abc.ScreenUpdating = True
abc.DisplayAlerts = True

Set abc = Nothing
Set wbk = Nothing
Set rst = Nothing

End Sub


Download Working File