Macro to email sheets from ETW South-985147

[howard]

I have tried to write code to email and attached sheets from ETW South-985147" to the last sheet

The range to be copied is from A1:E40 and the sheets must be attached as values i.e no formulas. The formulas on the active workbook to remain intact

 Sub EmailRemittanceAdvises()

Dim Ztext As String
Dim Zsubject As String
Dim I As Long
Application.ScreenUpdating = False
  "
    For I = Sheets("ETW South-985147").Index To Worksheets.Count
With Sheets(I)

Ztext = [bodytext]                              'read in text from named cell
     .Range("A1:E40").Copy
      .Range("a1:E40").PasteSpecial xlValues
End With
    
    With ActiveWorkbook
    
        Application.DisplayAlerts = False
.SaveAs Environ("TMP") & "\" & ThisWorkbook.Sheets("Email Remittance Advises").Name & ".xlsx"

        Application.DisplayAlerts = True
        .Close (True)
    End With
    
    With CreateObject("Outlook.Application").CreateItem(0)
        .To = Join(Application.Transpose(Sheets("Email Remittance Advises").Range("AA1:AA3").Value), ";")
        .Subject = "Remittance Advises"
        .Body = Ztext
        
      .Attachments.Add Environ("TMP") & "\" & ThisWorkbook.Sheets("Email Remittance Advises").Name & ".xlsx"
        .Display
        '.send
    End With
     Next I
       End Sub

When running the macro the email is not being created


It would be appreciated if someone could kindly amend my code

 

[howard]

I have also posted on link below

Email and attach a range for specific sheets

I have tried to write code to email and attached sheets from ETW South-985147" to the last sheet The range to be copied is from A1:E40 and the sheets must be attached as values i.e no formulas. The formulas on the active workbook to remain intact Sub EmailRemittanceAdvises() Dim...

www.excelforum.com