Tip Printed from ExcelTip.com
Mail sheet(s) to one or more people using VBA in Microsoft Excel

VBA macro tip contributed by Ron de Bruin, Microsoft MVP - Excel



Add new sheet, change the sheet name to mail.
Every mail you want to send will use 3 columns.
  1. in column A - enter sheet or sheets name you want to send.
  2. in column B - enter E-mail address.
  3. in column C - the subject title appears at the top of the E-mail message.
Column A:C enter information for the first mail and you may use columns D:F for the second one.
you can send 85 different E-mails this way (85*3 = 255 columns).
 Sub Mail_sheets()
    Dim MyArr As Variant
    Dim last As Long
    Dim shname As Long
    Dim a As Integer
    Dim Arr() As String
    Dim N As Integer
    Dim strdate As String
    For a = 1 To 253 Step 3
        If ThisWorkbook.Sheets("mail").Cells(1, a).Value = "" Then Exit Sub
        Application.ScreenUpdating = False
        last = ThisWorkbook.Sheets("mail").Cells(Rows.Count, a).End(xlUp).Row
        N = 0
        For shname = 1 To last
            N = N + 1
            ReDim Preserve Arr(1 To N)
            Arr(N) = ThisWorkbook.Sheets("mail").Cells(shname, a).Value
        Next shname
        ThisWorkbook.Worksheets(Arr).Copy
        strdate = Format(Date, "dd-mm-yy") & " " & Format(Time, "h-mm-ss")
        ActiveWorkbook.SaveAs "Part of " & ThisWorkbook.Name _
                            & " " & strdate & ".xls"
        With ThisWorkbook.Sheets("mail")
            MyArr = .Range(.Cells(1, a + 1), .Cells(Rows.Count, a + 1).End(xlUp))
        End With
        ActiveWorkbook.SendMail MyArr, ThisWorkbook.Sheets("mail").Cells(1, a + 2).Value
        ActiveWorkbook.ChangeFileAccess xlReadOnly
        Kill ActiveWorkbook.FullName
        ActiveWorkbook.Close False
        Application.ScreenUpdating = True
    Next a
End Sub