Mail every Worksheet with address in cell A1 using VBA in Microsoft Excel

This macro will send each sheet to one person.

• Create a new workbook with the Sheet.
• Save the workbook before mailing it
• Delete the file from your hard disk after it is sent.

Sub Mail_every_Worksheet()
    Dim strDate As String
    Dim sh As Worksheet
    Application.ScreenUpdating = False
    For Each sh In ThisWorkbook.Worksheets
        If sh.Range("a1").Value Like "*@*" Then
            sh.Copy
            strDate = Format(Date, "dd-mm-yy") & " " & Format(Time, "h-mm-ss")
            ActiveWorkbook.SaveAs "Part of " & ThisWorkbook.Name _
                                & " " & strDate & ".xls"
            ActiveWorkbook.SendMail ActiveSheet.Range("a1").Value, _
                                    "This is the Subject line"
            ActiveWorkbook.ChangeFileAccess xlReadOnly
            Kill ActiveWorkbook.FullName
            ActiveWorkbook.Close False
        End If
    Next sh
    Application.ScreenUpdating = True
End Sub