convert cells in worksheet to values

[Ray707]

Hello,

I have a VBA that automatically sends out the first worksheet of my file to stakeholders via a command button. The problem is that the worksheet has pivot tables in it, so when it gets sent, stakeholders can change the filter in the pivot tables and view other departments costs. I need to find a way round this and I am thinking that the best solution is to convert/paste the worksheet cells to values before the email gets generated as this would prevent the filter being available in the pivots - I was wondering if anyone could help with this?

Here is what the code currently looks like:

Private Sub commandbutton1_click()
    'update 20131209
    
    Dim wb1 As Workbook, wb2 As Workbook
    Dim sfilepath As String, sfilename As String
    Dim iformat As Integer


    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    Set wb1 = Application.ActiveWorkbook
    ActiveSheet.Copy
    Set wb2 = Application.ActiveWorkbook
    
    sfilepath = Environ$("temp")
    sfilename = sfilepath & "\ " & wb1.Name
    iformat = wb1.FileFormat
    wb2.SaveAs sfilename, iformat
    wb2.Close
    
    With CreateObject("outlook.application").createitem(0)
        .to = Sheet7.Range("G3")
        .cc = ""
        .bcc = ""
        .Subject = Sheet7.Range("A5")
        .body = "Hello," & vbLf & vbLf & "Please find attached the YTD third party and time costs." & vbLf & vbLf & "Thanks," & vbLf & "Ray"
        .attachments.Add sfilename
        .send
    End With
    
    Kill sfilename
    
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    
End Sub


-----------------------------------------


Private Sub Worksheet_Change(ByVal Target As Range)


'This line stops the worksheet updating on every change, it only updates when cell
'A1:B2 is touched
If Intersect(Target, Range("A1:B2")) Is Nothing Then Exit Sub


'Set the Variables to be used
Dim pt As PivotTable
Dim Field As PivotField
Dim NewCat As String


'Here you amend to suit your data for first pivot table
Set pt = Worksheets("New Business").PivotTables("PivotTable7")
Set Field = pt.PivotFields("Job No.")
NewCat = Worksheets("New Business").Range("B1").Value


'This updates and refreshes the PIVOT table
With pt
Field.ClearAllFilters


Field.CurrentPage = NewCat
pt.RefreshTable
End With




'Here you amend to suit your data for second pivot table
Set pt = Worksheets("New Business").PivotTables("PivotTable1")
Set Field = pt.PivotFields("Job No.")
NewCat = Worksheets("New Business").Range("B1").Value


'This updates and refreshes the PIVOT table
With pt
Field.ClearAllFilters




Field.CurrentPage = NewCat
pt.RefreshTable
End With


End Sub

Here is a picture of what the worksheet currently looks like when it gets sent, notice that there's access to the filter in the pivot tables: https://ibb.co/Q88Vxxp

Here is a picture of what I would like the worksheet to look like (it's a different worksheet to mine but notice how there is no access to the filters, this is because the values have been hard copied/converted to values): https://ibb.co/7Vh7PNT

Please note, I don't want the cells to stay hard copied in the original file, I only want them hard copied in the email that gets sent out.

Any help would be appreciated!