Macro to attached sheets without formulas

[howard]

I have code to attach the folowing sheets in Outlook , but only want to attach these as values and to have the same format as source sheets

Inventory 150 Days +
Dashboard

See my code below

 Sub Email_Stock_Report()
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .CutCopyMode = False
    End With
   
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Strinbody As String
   
    Set Sourcewb = ActiveWorkbook
   
    ' Create a new workbook
    Set Destwb = Workbooks.Add
   
    ' Copy the specified sheets to the new workbook
    Sourcewb.Sheets(Array("Inventory 150 Days +", "Dashboard")).Copy Before:=Destwb.Sheets(1)
   
    ' Loop through each cell in the "Dashboard" sheet to remove formulas and retain formatting
    Dim wsDashboard As Worksheet
    Set wsDashboard = Destwb.Sheets("Dashboard")
   
    ' Remove formulas from the Dashboard sheet
    wsDashboard.UsedRange.Value = wsDashboard.UsedRange.Value
   
    ' Copy and paste values and formats for the "Inventory 150 Days +" sheet
    Dim wsInventory As Worksheet
    Set wsInventory = Destwb.Sheets("Inventory 150 Days +")
   
    ' Paste only values to remove formulas
    wsInventory.UsedRange.Value = wsInventory.UsedRange.Value
   
    ' Copy and paste formats for the "Inventory 150 Days +" sheet
    wsInventory.UsedRange.Copy
    wsInventory.Cells(1).PasteSpecial Paste:=xlPasteFormats
   
    Application.CutCopyMode = False
   
    ' Determine the Excel file extension/format
    FileExtStr = ".xlsm" ' Use .xlsm for macro-enabled workbook
    FileFormatNum = 52     ' Use 52 for .xlsm format
   
    ' Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "" & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
   
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
   
    With Destwb
        ' Delete "Sheet1" in the new workbook
        On Error Resume Next
        .Sheets("Sheet1").Delete
        On Error GoTo 0
       
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = "kevin.james@btr.com;frank.simons@btr.com"
            .CC = ""
            .BCC = ""
            .Subject = "Summary + Group Overaged Stock 150 Days +"
            Strinbody = "Hi Guys" & vbNewLine & vbNewLine
            Strinbody = Strinbody & "Attached please find Dashboard (summary) as well the New & Used 150 days +" & vbNewLine & vbNewLine
            Strinbody = Strinbody & "Regards" & vbNewLine & vbNewLine
            Strinbody = Strinbody & "Howard"
           
            .Body = Strinbody
            .Attachments.Add TempFilePath & TempFileName & FileExtStr
            .Display   ' Use .Send to send automatically or .Display to check email before sending
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
   
    ' Wait for a few seconds to ensure the email is sent before attempting to delete the file
    Application.Wait Now + TimeValue("00:00:05")
   
    ' Delete the temporary file
    On Error Resume Next
    Kill TempFilePath & TempFileName & FileExtStr
    On Error GoTo 0
   
    Set OutMail = Nothing
    Set OutApp = Nothing
   
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .CutCopyMode = False
    End With
End Sub

Kindly amend my Code

 

[Bosquedeguate]

Create a copy of the worksheet without formulas (i.e. Values only). Then attach the new values-only worksheets to your email?
Is that a workable option for you?

 

[howard]

Thanks, but I am looking for VBA to do this for me