Option Explicit 
 
Sub EmailandSaveCellValue() 
     
     'Variable declaration
    Dim oApp As Object, _ 
    oMail As Object, _ 
    WB As Workbook, _ 
    FileName As String, MailSub As String, MailTxt As String 
     
     '*************************************************  ********
     'Set email details; Comment out if not required
    Const MailTo = "some1@someone.com" 
    Const MailCC = "some2@someone.com" 
    Const MailBCC = "some3@someone.com" 
    MailSub = "Please review " & Range("Subject") 
    MailTxt = "I have attached " & Range("Subject") 
     '*************************************************  ********
     
     'Turns off screen updating
    Application.ScreenUpdating = False 
     
     'Makes a copy of the active sheet and save it to
     'a temporary file
    ActiveSheet.Copy 
    Set WB = ActiveWorkbook 
    FileName = Range("Subject") & " Text.xls" 
    On Error Resume Next 
    Kill "C:\" & FileName 
    On Error Goto 0 
    WB.SaveAs FileName:="C:\" & FileName 
     
     'Creates and shows the outlook mail item
    Set oApp = CreateObject("Outlook.Application") 
    Set oMail = oApp.CreateItem(0) 
    With oMail 
        .To = MailTo 
        .Cc = MailCC 
        .Bcc = MailBCC 
        .Subject = MailSub 
        .Body = MailTxt 
        .Attachments.Add WB.FullName 
        .Display 
    End With 
     
     'Deletes the temporary file
    WB.ChangeFileAccess Mode:=xlReadOnly 
    Kill WB.FullName 
    WB.Close SaveChanges:=False 
     
     'Restores screen updating and release Outlook
    Application.ScreenUpdating = True 
    Set oMail = Nothing 
    Set oApp = Nothing 
End Sub