I am copying a Pivot table from one workbook to another.
The Paste values & columns widths works fine but the paste formats only works properly (colours, text etc.) when the Pivot is not filtered, but if any filters are applied in Pivot only some of the text formatting is pasted into new sheet, none of the cell formatting is copied:
Code:
Private Sub CommandButton1_Click()
Dim FileName As String
Worksheets("PDLGenerator").Range("A3:H69").Copy ' copy the full Pivot chart range
Set NewBook = Workbooks.Add
NewBook.Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False ' Paste values into new sheet
NewBook.Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteFormats ' Paste formats into new sheet
NewBook.Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteColumnWidths ' Paste columns widths into new sheet
On Error Resume Next
FileName = Range("C1").Value & " PDL.xlsx" 'save new workbook as "Project Name from sheet" + " PDL.xlsx"
NewBook.SaveAs FileName
End Sub
The Paste values & columns widths works fine but the paste formats only works properly (colours, text etc.) when the Pivot is not filtered, but if any filters are applied in Pivot only some of the text formatting is pasted into new sheet, none of the cell formatting is copied:
Code:
Private Sub CommandButton1_Click()
Dim FileName As String
Worksheets("PDLGenerator").Range("A3:H69").Copy ' copy the full Pivot chart range
Set NewBook = Workbooks.Add
NewBook.Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False ' Paste values into new sheet
NewBook.Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteFormats ' Paste formats into new sheet
NewBook.Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteColumnWidths ' Paste columns widths into new sheet
On Error Resume Next
FileName = Range("C1").Value & " PDL.xlsx" 'save new workbook as "Project Name from sheet" + " PDL.xlsx"
NewBook.SaveAs FileName
End Sub