Macro crashes while creating pivot out of large data sets - vba

Question

I am quite new to VBA and excel macros but want to automate certain reports for work and I am really hoping for someone's help. I tried to fix it myself by watching YouTube videos and reading stackoverflow but the solution didn't match with my issue. For now I created few macros but i am stuck with the one which should actually create a pivot table.
I first created a regular table out of the data I had (using TableP Macro beloew). It looks like it works fine (tested few other data sheets) :
Sub tableP()
'
' tableP Macro (Creates a table of the existing data sheet, regardless the data input)
'
ActiveCell.Cells.Select
ActiveCell.Activate
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$1:$1048576"), , xlYes).Name = _
"Table2"
ActiveCell.Cells.Select `
`End Sub `
The second macro (below) would ideally take that table (an object) and create a pivot table, however it crashes (excel stops working while I run the macro) each time I use a bigger dataset.
Sub Macro1test() '
' Macro1test creates dataset out of the existing table
'
Dim dataname As String
Dim Newsheet As String
dataname = ActiveSheet.ListObjects(1).Name
Sheets.Add
Newsheet = ActiveSheet.Name
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
dataname, Version:=xlPivotTableVersion14).CreatePivotTable TableDestination _
:=Newsheet & "!R3C1", TableName:="PivotTable2", DefaultVersion:= _
xlPivotTableVersion14
Sheets.Select
Cells(3, 1).Select
End Sub
Can please someone let me know what am I doing wrong and what steps am missing to be able to apply those macros on any data set?

Answer 1

Try the code below, explanations inside the code's comments:
Option Explicit
Sub Macro1test()
' Macro1test creates dataset out of the existing table
'
Dim dataname As String
Dim RngStr As String
Dim Newsheet As String
Dim NewSht As Worksheet
Dim PvtCache As PivotCache
Dim PvtTbl As PivotTable
' set the Range String for the Pivot Cache Source Data)
RngStr = ActiveSheet.ListObjects(1).Range.Address(False, False, xlA1, xlExternal)
' add a new sheet
Set NewSht = ThisWorkbook.Sheets.Add(after:=ActiveSheet)
' set the Pivot Cache object
Set PvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=RngStr)
' set the New Pivot Table object
Set PvtTbl = NewSht.PivotTables.Add(PivotCache:=PvtCache, TableDestination:=NewSht.Range("A3"), TableName:="PivotTable2")
End Sub