Can I send emails to separate people with just one tab of a workbook?

[HelenG68]

I have a workbook with 10 tabs of budget information for 10 departments. Can I send just one tab (not whole workbook) to one person from the workbook, for each tab all at the same time? Like a merge I think. Starting this from scratch as it is taking ages for me to do separate each month

 

[Logit]

From the files of Ron deBruin :

Option Explicit

Sub Mail_Every_Worksheet()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object

    TempFilePath = Environ$("temp") & "\"

    If Val(Application.Version) < 12 Then
        'You use Excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007-2016
        FileExtStr = ".xlsm": FileFormatNum = 52
        FileExtStr = ".xlsx": FileFormatNum = 51
        
    End If

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

    Set OutApp = CreateObject("Outlook.Application")

    For Each sh In ThisWorkbook.Worksheets
        If sh.Range("A1").Value Like "?*@?*.?*" Then

            sh.Copy
            Set wb = ActiveWorkbook

            TempFileName = sh.Name   '"Sheet " & sh.Name & " of " _
                         & ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

            Set OutMail = OutApp.CreateItem(0)

            With wb
                .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

                On Error Resume Next
                With OutMail
                    .to = sh.Range("A1").Value
                    .CC = ""
                    .BCC = ""
                    .Subject = "This is the Subject line"
                    .Body = "Hi there"
                    .Attachments.Add wb.FullName
                    'You can add other files also like this
                    '.Attachments.Add ("C:\test.txt")
                    .Display
                    '.Send   'or use .Display
                End With
                On Error GoTo 0

                .Close savechanges:=False
            End With
            
            Set OutMail = Nothing

            Kill TempFilePath & TempFileName & FileExtStr

        End If
    Next sh

    Set OutApp = Nothing

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

Beginning with Sheet1, in cell A1 of each sheet, enter a different email address where you want the data on that sheet to go.

Excel will attach the sheet to the individual's email automatically. Presently the code is set to display the email first ... requiring you to click SEND on each email to
get it to go. You can edit the macro code so the email is automatically sent. (See comments in code re: DISPLAY and SEND)

 

[HelenG68]

From the files of Ron deBruin :

Option Explicit

Sub Mail_Every_Worksheet()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object

    TempFilePath = Environ$("temp") & "\"

    If Val(Application.Version) < 12 Then
        'You use Excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007-2016
        FileExtStr = ".xlsm": FileFormatNum = 52
        FileExtStr = ".xlsx": FileFormatNum = 51
       
    End If

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

    Set OutApp = CreateObject("Outlook.Application")

    For Each sh In ThisWorkbook.Worksheets
        If sh.Range("A1").Value Like "?*@?*.?*" Then

            sh.Copy
            Set wb = ActiveWorkbook

            TempFileName = sh.Name   '"Sheet " & sh.Name & " of " _
                         & ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

            Set OutMail = OutApp.CreateItem(0)

            With wb
                .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

                On Error Resume Next
                With OutMail
                    .to = sh.Range("A1").Value
                    .CC = ""
                    .BCC = ""
                    .Subject = "This is the Subject line"
                    .Body = "Hi there"
                    .Attachments.Add wb.FullName
                    'You can add other files also like this
                    '.Attachments.Add ("C:\test.txt")
                    .Display
                    '.Send   'or use .Display
                End With
                On Error GoTo 0

                .Close savechanges:=False
            End With
           
            Set OutMail = Nothing

            Kill TempFilePath & TempFileName & FileExtStr

        End If
    Next sh

    Set OutApp = Nothing

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

Beginning with Sheet1, in cell A1 of each sheet, enter a different email address where you want the data on that sheet to go.

Excel will attach the sheet to the individual's email automatically. Presently the code is set to display the email first ... requiring you to click SEND on each email to
get it to go. You can edit the macro code so the email is automatically sent. (See comments in code re: DISPLAY and SEND)

Thank you for this, sorry for delay in replying