S
san.francisco.scrabble
I have a variable number of worksheets for which I’d like to automate
a pivot table consolidation routine.
I’ve tried the code below not to avail. The source keeps being only on
sheet4, while for my test, it should pickup sheet2 through sheet5.
Any thoughts?
Sub test()
Application.ScreenUpdating = False
Dim wsn As String
Dim i As Integer
Dim prange As String
Dim PCrange As String
Dim rangearr() As String
ReDim Preserve rangearr(i To Worksheets.Count - 5)
For i = 2 To Worksheets.Count - 3 Step 1
wsn = Worksheets(i).Name
Sheets(wsn).Select
prange = Range(Range("A1"), Range("A1").End(xlDown).Offset(0,
1)).Address(ReferenceStyle:=xlR1C1, _
RowAbsolute:=True, _
ColumnAbsolute:=True)
PCrange = wsn & "!" & prange
If (i - 3) < 0 Then rangearr(0) = PCrange _
Else: rangearr(LBound(rangearr) + (i - 2)) = PCrange
Next i
Sheets("sheet1").Select
ActiveWorkbook.PivotCaches.Add(SourceType:=xlConsolidation,
SourceData:= _
rangearr).CreatePivotTable TableDestination:=Range("a1"), _
TableName:="PivotTable1"
With ActiveSheet.PivotTables("PivotTable1")
..ColumnGrand = False
..HasAutoFormat = False
..RowGrand = False
..SmallGrid = False
End With
ActiveSheet.PivotTables("PivotTable1").SmallGrid = False
ActiveSheet.PivotTables("PivotTable1").PivotFields("Data").PivotItems
( _
"Sum of Value").Position = 1
Application.CommandBars("PivotTable").Visible = False
End Sub
a pivot table consolidation routine.
I’ve tried the code below not to avail. The source keeps being only on
sheet4, while for my test, it should pickup sheet2 through sheet5.
Any thoughts?
Sub test()
Application.ScreenUpdating = False
Dim wsn As String
Dim i As Integer
Dim prange As String
Dim PCrange As String
Dim rangearr() As String
ReDim Preserve rangearr(i To Worksheets.Count - 5)
For i = 2 To Worksheets.Count - 3 Step 1
wsn = Worksheets(i).Name
Sheets(wsn).Select
prange = Range(Range("A1"), Range("A1").End(xlDown).Offset(0,
1)).Address(ReferenceStyle:=xlR1C1, _
RowAbsolute:=True, _
ColumnAbsolute:=True)
PCrange = wsn & "!" & prange
If (i - 3) < 0 Then rangearr(0) = PCrange _
Else: rangearr(LBound(rangearr) + (i - 2)) = PCrange
Next i
Sheets("sheet1").Select
ActiveWorkbook.PivotCaches.Add(SourceType:=xlConsolidation,
SourceData:= _
rangearr).CreatePivotTable TableDestination:=Range("a1"), _
TableName:="PivotTable1"
With ActiveSheet.PivotTables("PivotTable1")
..ColumnGrand = False
..HasAutoFormat = False
..RowGrand = False
..SmallGrid = False
End With
ActiveSheet.PivotTables("PivotTable1").SmallGrid = False
ActiveSheet.PivotTables("PivotTable1").PivotFields("Data").PivotItems
( _
"Sum of Value").Position = 1
Application.CommandBars("PivotTable").Visible = False
End Sub