You are here:

Excel/emailing worksheets macro


I have successfuly utlized your macro to email worksheets to specific individuals.
Thank you very much ...
Is there a way to preserve pivot tables & their formatting?
Thank you in advance!  A very helpful macro!
Brenda Cox

Here is some code that does what you need I expect.

1. Create a new worksheet with this info:

     A          B          C
1: Sheet name  EMail address          Cell address
2:  Sheet1          A1:H10
3:  Sheet2       B2:G100

Paste this code into a normal module:

Sub MailSets()
   Dim oCell As Range
   'Make sure you change "Sheet1" below,
   'so it matches the name of the worksheet with email settings
   For Each oCell In Sheets("Sheet1").UsedRange.Columns(1).Cells
       If oCell.Row > 1 Then
         'Skip first row; contains header
         If Not IsEmpty(oCell.Value) Then
         Mail_Selection Sheets(oCell.Value).Range(oCell.Offset(, 2).Value), oCell.Offset(, 1).Value
         End If
       End If
End Sub

Sub Mail_Selection(Source As Range, sTo As String)
'Working in 2000-2010
   Dim Dest As Workbook
   Dim wb As Workbook
   Dim TempFilePath As String
   Dim TempFileName As String
   Dim FileExtStr As String
   Dim FileFormatNum As Long
   Dim OutApp As Object
   Dim OutMail As Object

  If Source Is Nothing Then
       MsgBox "The source is not a range or the sheet is protected, " & _
         "please correct and try again.", vbOKOnly
       Exit Sub
   End If

  If ActiveWindow.SelectedSheets.Count > 1 Or _
      Source.Cells.Count = 1 Or _
      Source.Areas.Count > 1 Then
       MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
         "You have more than one sheet selected" & vbNewLine & _
         "or you only selected one cell" & vbNewLine & _
         "or you selected more than one area." & vbNewLine & vbNewLine & _
         "Please correct and try again.", vbOKOnly
       Exit Sub
   End If

  With Application
       .ScreenUpdating = False
       .EnableEvents = False
   End With

  Set wb = ActiveWorkbook
   Set Dest = Workbooks.Add(xlWBATWorksheet)
   With Dest.Sheets(1)
       .Cells(1).PasteSpecial Paste:=8
       .Cells(1).PasteSpecial Paste:=xlPasteValues
       .Cells(1).PasteSpecial Paste:=xlPasteFormats
       Application.CutCopyMode = False
   End With

  TempFilePath = Environ$("temp") & "\"
   TempFileName = "Selection of " & wb.Name & " " _
         & Format(Now, "dd-mmm-yy h-mm-ss")

  If Val(Application.Version) < 12 Then
       'You use Excel 2000-2003
       FileExtStr = ".xls": FileFormatNum = -4143
       'You use Excel 2007-2010
       FileExtStr = ".xlsx": FileFormatNum = 51
   End If

  Set OutApp = CreateObject("Outlook.Application")
   Set OutMail = OutApp.CreateItem(0)

  With Dest
       .SaveAs TempFilePath & TempFileName & FileExtStr, _
       On Error Resume Next
       With OutMail
         .To = sTo
         .CC = ""
         .BCC = ""
         .Subject = "This is the Subject line"
         .Body = "Hi there"
         .Attachments.Add Dest.FullName
         'You can add other files also like this
         '.Attachments.Add ("C:\test.txt")
         .Send   'or use .Display
       End With
       On Error GoTo 0
       .Close SaveChanges:=False
   End With

  Kill TempFilePath & TempFileName & FileExtStr

  Set OutMail = Nothing
   Set OutApp = Nothing

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

Hi Brenda,

I strongly suspect this code has been copied from ROn de Bruin's website. I suggest you to look here:

or here:

or here:
About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here


All Answers

Answers by Expert:

Ask Experts


Jan Karel Pieterse


Excel and Excel/VBA questions


Excel MVP

Self employed Excel developer

Bachelor in Chemical Engineering

Awards and Honors
Microsoft MVP award since 2002

Past/Present Clients
Shell, Fortis bank, ABN-AMRO bank, Morgan Stanley, ...

©2017 All rights reserved.