Excel VBA to create a series of new pivot tables

[sschwant]

I have a time tracking table with 3 columns in a work sheet labeled "Template". Each tab of the workbook will be labeled in date format mm-dd-yy and the NewSheet sub below works well (it adds a new tab and labels it accordingly). As each new daily sheet is created - the table in columns B-D on the template get copied over to columns A:C on the new sheet (Time of day in fifteen " increments, Activity, and Hours as 0.25). Next what I want to do is create a pivot table off the new daily time tracking table to summarize the activities by hour. But I want each new pivot table to automatically pull from the new sheet (and not be pointing to a different table such as on the Template tab & also be created on the same new sheet rather than another new sheet). Without a dim function and a counter to keep Excel VBA from getting confused - I'm not sure this is possible; but not sure how to edit the code below (in macro5)...

Grateful for any assistance! Let me know if there are questions.

Thanks!



Sub NewSheet()

Application.ScreenUpdating = False
Dim wshL As Worksheet
Dim wshN As Worksheet
Dim d As Date
Set wshL = Worksheets(Worksheets.Count)
d = DateValue(wshL.Name)
Set wshN = Worksheets.Add(After:=wshL)
wshN.Name = Format(d + 1, "mm-dd-yy")

Sheets("Template").Select
Columns("B:D").Select
Selection.Copy
wshN.Select
ActiveSheet.Paste
ActiveWindow.Zoom = 90
Rows("2:2").Select
ActiveWindow.FreezePanes = True
Range("A1").Select
Application.ScreenUpdating = True

End Sub




Sub Macro5()
'
' Macro5 Macro
'




Range("A1:C54").Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"06-29-20!R1C1:R54C3", Version:=6).CreatePivotTable TableDestination:= _
"06-29-20!R2C5", TableName:="PivotTable5", DefaultVersion:=6
Sheets("06-29-20").Select
Cells(2, 5).Select
ActiveWorkbook.ShowPivotTableFieldList = True
With ActiveSheet.PivotTables("PivotTable4").PivotFields( _
"Daily Time Tracker - Activity")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable4").AddDataField ActiveSheet.PivotTables( _
"PivotTable4").PivotFields("Hours"), "Sum of Hours", xlSum
ActiveWorkbook.ShowPivotTableFieldList = False
With ActiveSheet.PivotTables("PivotTable5").PivotFields( _
"Daily Time Tracker - Activity")
.PivotItems("(blank)").Visible = False
End With
Range("F2:F10").Select
Selection.Style = "Comma"
Range("E2").Select
ActiveSheet.PivotTables("PivotTable5").TableStyle2 = "PivotStyleMedium9"
Range("F12").Select
End Sub

[Paul_Hossler]

If I understand correctly

BTW, you don't need to select things to use them




Option Explicit


Sub Macro5()
Dim wsTodaysSheetName As String

wsTodaysSheetName = Format(Now, "mm-dd-yy")

Range("A1:C54").Select

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
wsTodaysSheetName & "!R1C1:R54C3", Version:=6).CreatePivotTable TableDestination:= _
wsTodaysSheetName & "!R2C5", TableName:="PivotTable5", DefaultVersion:=6
Sheets(wsTodaysSheetName).Select
Cells(2, 5).Select
ActiveWorkbook.ShowPivotTableFieldList = True
With ActiveSheet.PivotTables("PivotTable4").PivotFields( _
"Daily Time Tracker - Activity")
.Orientation = xlRowField
.Position = 1
End With

ActiveSheet.PivotTables("PivotTable4").AddDataField ActiveSheet.PivotTables( _
"PivotTable4").PivotFields("Hours"), "Sum of Hours", xlSum
ActiveWorkbook.ShowPivotTableFieldList = False
With ActiveSheet.PivotTables("PivotTable5").PivotFields( _
"Daily Time Tracker - Activity")
.PivotItems("(blank)").Visible = False
End With
Range("F2:F10").Select
Selection.Style = "Comma"
Range("E2").Select
ActiveSheet.PivotTables("PivotTable5").TableStyle2 = "PivotStyleMedium9"
Range("F12").Select
End Sub

[mana]

Sub test()
Dim wshL As Worksheet
Dim wshN As Worksheet
Dim d As Date

Set wshL = Worksheets(Worksheets.Count)
d = DateValue(wshL.Name)

wshL.Copy After:=wshL
Set wshN = ActiveSheet
wshN.Name = Format(d + 1, "mm-dd-yy")

Worksheets("Template").Columns("B:D").Copy wshN.Range("A1")

wshN.Range("E2").PivotTable.SourceData = _
wshN.Range("A1").CurrentRegion.Address(, , xlR1C1, True)

End Sub

[sschwant]

Sub test()
Dim wshL As Worksheet
Dim wshN As Worksheet
Dim d As Date

Set wshL = Worksheets(Worksheets.Count)
d = DateValue(wshL.Name)

wshL.Copy After:=wshL
Set wshN = ActiveSheet
wshN.Name = Format(d + 1, "mm-dd-yy")

Worksheets("Template").Columns("B:D").Copy wshN.Range("A1")

wshN.Range("E2").PivotTable.SourceData = _
wshN.Range("A1").CurrentRegion.Address(, , xlR1C1, True)

End Sub