.Font.Size = 14
End With
‘ Copy the Pivot Table data to row 3 of the Report sheet
‘ Use Offset to eliminate the title row of the pivot table
PT.TableRange2.Offset(1, 0).Copy
WSR.[A3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats
PT.TableRange2.Clear
Set PTCache = Nothing
‘ Fill in the Outline view in column A
‘ Look for last row in column B since many rows
‘ in column A are blank
FinalReportRow = WSR.Cells(Rows.Count, 2).End(xlUp).Row
With Range(“A3”).Resize(FinalReportRow - 2, 1)
With .SpecialCells(xlCellTypeBlanks)
.FormulaR1C1 = “=R[-1]C”
End With
.Value = .Value
End With
‘ Do some basic formatting
‘ Autofit columns, bold the headings, right-align
Selection.Columns.AutoFit
Range(“A3”).EntireRow.Font.Bold = True
Range(“A3”).EntireRow.HorizontalAlignment = xlRight
Range(“A3:B3”).HorizontalAlignment = xlLeft
‘ Repeat rows 1-3 at the top of each page
WSR.PageSetup.PrintTitleRows = “$1:$3”
‘ Add subtotals
FinalCol = Cells(3, Columns.Count).End(xlToLeft).Column
ReDim Preserve TotColumns(1 To FinalCol - 2)
For i = 3 To FinalCol
TotColumns(i - 2) = i
Next i
Selection.Subtotal GroupBy:=1, Function:=xlSum, _
TotalList:=TotColumns, Replace:=True, _
PageBreaks:=True, SummaryBelowData:=True
‘ Make sure the columns are wide enough for totals
GrandRow = WSR.Cells(Rows.Count, 1).End(xlUp).Row
Cells(3, 3).Resize(GrandRow - 2, FinalCol - 2).Columns.AutoFit
Cells(GrandRow, 3).Resize(1, FinalCol - 2).NumberFormat = “#,##0,K”
‘ Add a page break before the Grand Total row, otherwise
‘ the product manager for the final Line will have two totals
WSR.HPageBreaks.Add Before:=Cells(GrandRow, 1)
End Sub
Figure 11.11 shows the report produced by this code.
Chapter 11 Using VBA to Create Pivot Tables
256
11
Listing 11.3 Continued
12_0789736012_CH11.qxd 12/11/06 6:26 PM Page 256
To Next Page
Loading...
Need help?
General
