I'm not starting totally from scratch.  The code I have so far is below, and is a cut and paste from something I once found online, but can't find again..  It works, but I couldn't hand this off to somebody else to use, unless they are comfortable with the VBA.  The items that need to be cleaned up are:

- specifying that the emails are in a fixed range, starting in B3, and going to whatever the last filled Row of column D is.

- adding a text box to the worksheet so that the text for the body of the email can be entered there, instead of hardcoded within the VBA

- popping up a "Working" or similar message while the macro is running

The command button associated with this code is on the Scouts worksheet I referenced above.  I've spend hours on each of these 3 items, and not been able to get anything to work.

**************************************************************************

Private Sub CommandButton1_Click()
     Dim Address As Variant
     Dim Dict As Object
     Dim DstWkb As Workbook
     Dim EmailInfo As Variant
     'Dim Filename As String
     Dim i As Long, j As Long
     Dim NewWkb As Workbook
     Dim olApp As Object
     Dim Rng As Range
     Dim SrcWkb As Workbook
     Dim SrcWks As Worksheet
     Dim SheetName As String
     Dim SheetNames As Variant

     ' Email Subject line.
      SubjectLine = "BSA Troop 454 Scout Account Balances"

     ' Email Message.
     MsgBody = "See attached file for activity and balance in your Scout account. Any siblings share a single account."
     MsgBody = MsgBody & vbCrLf & vbCrLf
     MsgBody = MsgBody & "This is the first of our new monthly reporting process for Scout Account balances."
     MsgBody = MsgBody & " Please note that the amount shown in the workbook does not include the following item(s):"
     MsgBody = MsgBody & vbCrLf
     MsgBody = MsgBody & " * 2016 Popcorn Sales"

     MsgBody = MsgBody & vbCrLf & vbCrLf
     MsgBody = MsgBody & "Accounts are credited with amounts earned through Troop fundraisers. "
     MsgBody = MsgBody & "Funds in these accounts may be used for dues, Troop clothing, and Troop activities. "
     MsgBody = MsgBody & "Any time you would like to use the Scout Account to pay for an item, please "
     MsgBody = MsgBody & "let the activity coordinator know, and s/he will report the information to me."

     MsgBody = MsgBody & vbCrLf & vbCrLf
     MsgBody = MsgBody & "Email addresses have been pulled from TroopMaster, however, if you just want "
     MsgBody = MsgBody & "to cease receipt of these emails, please send reply email with UNSUBSCRIBE in the message body."

     MsgBody = MsgBody & vbCrLf & vbCrLf
     MsgBody = MsgBody & "Thanks,"
     MsgBody = MsgBody & vbCrLf
     MsgBody = MsgBody & "Ruth Glaser, Troop 454 Treasurer"

     ' Pick up name of the workbook whose sheets will copied. - commented out.  Appeared not to be necessary.
     ' Filename = ActiveWorkbook.FullName

     Set Rng = Range("A1").CurrentRegion

     ' EmailInfo starts in column "B" to the last column used.
     Set EmailInfo = Intersect(Rng, Rng.Offset(1, 0))

     ' Copy the sheet names and email addresses into arrays for faster processing.
     SheetNames = EmailInfo.Columns(1).Cells.Value
     EmailInfo = Intersect(EmailInfo, EmailInfo.Offset(0, 1)).Value

     ' Create an associative array to hold the email addresses and the sheet names for each one.
     Set Dict = CreateObject("Scripting.Dictionary")
     Dict.CompareMode = vbTextCompare
     
     ' Collect email addresses and sheet names associated with each address.
     For i = 1 To UBound(EmailInfo, 1)
          For j = 1 To UBound(EmailInfo, 2)
               SheetName = SheetNames(i, 1)
               Address = EmailInfo(i, j)
               If Address <> "" Then
                    If Not Dict.Exists(Address) Then
                         Dict.Add Address, SheetName
                    Else
                         SheetName = Dict(Address) & "," & SheetName
                         Dict(Address) = SheetName
                    End If
               End If
          Next j
     Next i

     ' Open the workbook with the sheets to be copied as email attachments.
     Set SrcWkb = ThisWorkbook
     Set olApp = CreateObject("Outlook.Application")

     For Each Address In Dict.Keys

          ' Create a new workbook to be used as the attachment with Sheet1, which is later deleted
          Set DstWkb = Workbooks.Add(xlWBATWorksheet)

          ' Copy all the sheets associated with an email to the new workbook.
          SheetNames = Split(Dict(Address), ",")
          For i = 0 To UBound(SheetNames, 1)

               SrcWkb.Worksheets(SheetNames(i)).Copy After:=DstWkb.Worksheets(DstWkb.Worksheets.Count)
               ActiveSheet.Name = SheetNames(i)

          Next i

          ' Turn off prompts
          Application.DisplayAlerts = False

          ' Delete Sheet1 so that workbook only contains sheets w scout information.
          Sheets("Sheet1").Delete

          ' Save the new workbook.
          DstWkb.SaveAs Filename:="Attachment1.xlsx"

          ' Turn prompts back on
          Application.DisplayAlerts = True

          ' Email the workbook as an attachment.
          With olApp.CreateItem(0)
               .To = Address
               .Subject = SubjectLine
               .Body = MsgBody
               .Attachments.Add DstWkb.FullName, 1, 1
               .Send
          End With

          ' Close the new workbook
          DstWkb.Close SaveChanges:=False

          ' Then delete it
          Kill "Attachment1.xlsx"

     Next Address

     ' Close the source workbook whose sheets were copied
     SrcWkb.Close SaveChanges:=False

End Sub

macro seems not working ?  

Hi Maryland,

Sorry for the late answer. Can you please upload a sample file with your setup?

 

@David: how did you came to that conclusion? Just saying that it's not working without describing what happens, will not help us understand what does not work. Even a simple print screen of the error will make things more clear.

Sorry my ignorance as I simply copy the VB code to a workbook , and test run Macro

with some testing data but failed

I figured out how to do what I wanted, after a lot of Google searches.  I'll post the final code, and a better description of the data, tomorrow, when I have more time.  It might be helpful to somebody else.  Thanks for the response, though, or I would have forgotten I posted the question!

Here's a pared down version of the workbook.  There are normally 50-60 different tabs, one for each boy.  I stripped out the email addresses on the Emails worksheet, so in order to see how this works, you need to enter some emails into that worksheet.

This works, but runs REALLY slowly, like it took almost an hour to send out 95 emails (each name can have 1, 2, or 3 emails associated with it).  It used to run faster before I used a defined area for the emails and added the Userform.  The original code is above, which ran fast, but wasn't in any shape that I could pass on to somebody who didn't know VBA.