Macro to aufit Columns in Named range before attaching to Ouitlookq

[howard]

I have the folowing code to attach a named range in a sheet. The column width is perfect. Howver when the sheet is attached the column width in some columns is not wide enough and displays ###


Kindly test & amend code so that when the named range for the sheet is attached, the columns width fitts the size of the coluns

 Sub EmailRange()

Dim wb As Workbook, Path As String, Ztext As String, Zsubject As String

Ztext = [bodytext]                              'read in text from named cell
Zsubject = [SubjectText]

Set wb = ThisWorkbook: Path = "C:\My Documents"
With Workbooks.Add
    wb.Sheets("Sales Data").Range("EMLSales").Copy
    With ActiveSheet
        .Range("A1").PasteSpecial xlPasteValues
        .Columns.AutoFit
        .Name = "Sales Report"
    End With
    .SaveAs Path & "\" & "Sales Report" & ".xlsx"
    .Close True
End With
    With CreateObject("Outlook.Application").CreateItem(0)
    .display
        .To = Join(Application.Transpose(Sheets("Email Sales").Range("Z1:Z4").Value), ";")
        .CC = Join(Application.Transpose(Sheets("Email Sales").Range("AA1:AA12").Value), ";")
        .Subject = Zsubject
        .Body = Ztext
        
     .Attachments.Add Path & "\" & "Sales Report" & ".xlsx"
    '.Send
End With
Kill Path & "\" & "Sales Report" & ".xlsx"
End Sub