Here is one way I move sheets around.
You may need to creata a new workbook form your sheet, save that then attach it to tthe email.
Here is some ideas any way.
-------------------------------------------------------------------------------------
Sub copysheet()
Dim dest_file, final_file, Open_wkbk_sheet, Open_wkbk
Open_wkbk = ActiveWorkbook.Name ' Set variable to the workbook that holds the worksheet
Open_wkbk_sheet = ActiveWorkbook.ActiveSheet.Name ' Set variable to the sheet you want to move
dest_file = getfile 'Call another routine to open the destination workbook
MsgBox "Moving, " & Open_wkbk_sheet & " to workbook, " & dest_file & ".", vbYesNo + vbInformation
Workbooks(Open_wkbk).Sheets(Open_wkbk_sheet).Visible = True
Workbooks(Open_wkbk).Sheets(Open_wkbk_sheet).Move After:=Workbooks(dest_file).Sheets(1)
'Application.Dialogs(xlDialogSaveAs).Show
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "File path"
Application.DisplayAlerts = True
End Sub
---------------------------------------------------------------------------------
in the top of your module put these declarations
Public olApp As New Outlook.Application
Public nsMAPI As Outlook.NameSpace
Public exp As Outlook.Explorer
-------------------------------------------------------------------------------------
Sub SendAnEmailWithOutlook(final_file_name As String)
' creates and sends a new e-mail message with Outlook requires a reference to the Microsoft Outlook 8.0 Object Library
' Alt-F11>Tools>References>Microsoft Outlook 98 Object Library
Dim OLF As Outlook.MAPIFolder, olmailitem As Outlook.MailItem, ToContact As Recipient
Dim msgres, msgsnd, body_text, ff_name As String
Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set olmailitem = OLF.Items.Add ' creates a new e-mail message
ff_name = final_file_name + ".xls"
With olmailitem
.Subject = "Subject." ' message subject
Set ToContact = .Recipients.Add("email address") ' add a recipient
If Not ToContact.Resolve Then
msgres = MsgBox("Unable To resolve email address.", vbOKOnly + vbCritical)
End
End If
Set ToContact = .Recipients.Add("email address") ' add a BCC recipient
If Not ToContact.Resolve Then
msgres = MsgBox("Unable To resolve email address.", vbOKOnly + vbCritical)
End
End If
ToContact.Type = olCC ' set last recipient as CC
body_text = "Intro," & Chr(13) & Chr(13)
body_text = body_text & "Blah blah,"
body_text = body_text & " as of " & Format(Now(), "dd-mmm-yyyy") & "." & Chr(13) & Chr(13) ' the message text with 2 spaces
body_text = body_text & "Regards" & Chr(13)
body_text = body_text & "Name" & Chr(10) & Chr(13)
.Body = body_text
'.Attachments.Add "file path", olByValue, , "inc_sum_report.xls" ' insert attachment
.Attachments.Add "file path" & ff_name, olByValue, , ff_name
.OriginatorDeliveryReportRequested = True ' delivery confirmation
.ReadReceiptRequested = True ' read confirmation
msgsnd = MsgBox("Would you like to view your email before sending? " & Chr(13) & Chr(13) & _
"You must click send if you view your email first." & Chr(13) & Chr(13) & "Clicking No will send your email without viewing!", vbYesNo + vbInformation)
If msgsnd = vbYes Then
.Display 'Display the item
Else
'.Save ' saves the message for later editing
.Send ' sends the e-mail message (puts it in the Outbox if you are working off-line)
End If
End With
Set ToContact = Nothing
Set olmailitem = Nothing
Set OLF = Nothing
End Sub
---------------------------------------------------------------------------------
