Replace all formulas with values (& Pivot Tables

[Arcturus16a]

I have a macro which selects all sheets in a workbook and then converts the formulas to values so that I can email the file in the smallest possible form.
I would like to add some pivot tables to the workbook, but the macro converts only the formulas, not the pivot tables.
How can this code be modified to include pivot tables?

'Replace all formulas in all sheets with values

Dim shtSheet As Worksheet, shtActive As Worksheet
Dim rngR As Range, rngCell As Range
Application.ScreenUpdating = False
Set shtActive = ActiveWorkbook.ActiveSheet
For Each shtSheet In ActiveWorkbook.Sheets
With shtSheet
If .ProtectContents = False Then ' skip protected sheets
On Error Resume Next
Set rngR = .UsedRange.SpecialCells(xlCellTypeFormulas, _
xlErrors + xlLogical + xlNumbers + xlTextValues)
On Error GoTo 0
If Not rngR Is Nothing Then
For Each rngCell In rngR
rngCell.Value2 = rngCell.Value2
Next rngCell
End If
End If
End With
Next shtSheet
shtActive.Activate ' reset to original active sheet
[a2].Activate
Set shtActive = Nothing
Application.ScreenUpdating = True

[HansV]

You could add this line at the beginning:

Dim pvt As PivotTable

And within the With shtSheet ... End With block:

For Each pvt in shtSheet.PivotTables
  pvt.TableRange2.Copy
  pvt.TableRange2.PasteSpecial Paste:=xlPasteValues
Next pvt

[Arcturus16a]

Thank you Hans. Works like a charm!

I'm posting the finished code in case someone else could use it.

' Replace all formulas and Pivot Tables with values


Dim pvt As PivotTable

Dim shtSheet As Worksheet, shtActive As Worksheet
Dim rngR As Range, rngCell As Range
Application.ScreenUpdating = False
Set shtActive = ActiveWorkbook.ActiveSheet

For Each shtSheet In ActiveWorkbook.Sheets
With shtSheet
If .ProtectContents = False Then ' skip protected sheets
On Error Resume Next
Set rngR = .UsedRange.SpecialCells(xlCellTypeFormulas, _
xlErrors + xlLogical + xlNumbers + xlTextValues)
On Error GoTo 0
If Not rngR Is Nothing Then
For Each rngCell In rngR
rngCell.Value2 = rngCell.Value2
Next rngCell
End If
End If
For Each pvt In shtSheet.PivotTables
pvt.TableRange2.Copy
pvt.TableRange2.PasteSpecial Paste:=xlPasteValues
Next pvt

End With
Next shtSheet
shtActive.Activate ' reset to original active sheet
[a2].Activate
Set shtActive = Nothing
Application.ScreenUpdating = True

[F1Rumors]

Actually, you may want to consider an even simpler approach - just replace all contents with values, as follows:

Dim sht As Worksheet
For Each sht In Application.Worksheets
    sht.Cells.Copy
    sht.Cells.PasteSpecial Paste:=xlPasteValues
Next

In this fashion, you are eliminating all non-value entries on all sheets...