I am trying to code a button to create an email with the active
sheet as an attachment. Due to some restrictions with the other code
in the workbook, here is what I am wanting it to do.

- Copy Currently active sheet to a NEW work book (Including Sheet
protection cell values, formatiing , vba code (Include code under
“this workbook”, etc)
- Rename the new workbook to the Active sheet name that was copied
over.
- Attach the Workbook to a new out look email. (Without saving
workbook to a file.)
- Close the new workbook with out saving.

Here is the code I have so far, but am stuck as to how to copy active
sheet and rename it.

Sub Button1_Click()
Dim OL As Object ' Outlook Object
Dim EmailItem As Object ' A new mail item (e-mail)
Dim lngLoop As Long
Dim FileName As String ' The name of the file we are attaching
Dim SheetName As String ' Email Subject

Set OL = CreateObject("Outlook.Application") ' New Outlook
application
Set EmailItem = OL.CreateItem(OLMailItem) ' New MailItem

' Shut Down Screen and Events
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

SheetName = ActiveSheet.Name ' Email Subject

'Need Code here to create the new workbook with an
‘exact copy of the active worksheet in it. (Including
‘Sheet protection cell values, formatiing , vba code
‘ (Include code under “this workbook”, etc)
'
' I then need to rename the workbook to the sheet
‘ name copied. (SheetName)

' Load Email
With EmailItem ' with the newly created e-mail
.Subject = SheetName
.Body = SheetName
.Attachments.Add SheetName 'Add New Workbook
.Display ' Load The Email
End With

Set OL = Nothing ' clean down memory
Set EmailItem = Nothing ' clean down memory

‘ Code here to close the New workbook (no Save)

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub