You can use

If you want to mail to all E-mail addresses in column C use this code
instead of .To = "

Dim cell As Range
Dim strto As String
For Each cell In ThisWorkbook.Sheets("Sheet1") _
.Columns("C").Cells.SpecialCells(xlCellTypeConstan ts)
If cell.Value Like "*@*" Then
strto = strto & cell.Value & ";"
End If
Next
strto = Left(strto, Len(strto) - 1)

See also
http://www.rondebruin.nl/mail/tips2.htm


--
Regards Ron de Bruin
http://www.rondebruin.nl



"Appelq" wrote in message ...
I have a Workbook that gets updated periodically and when updated it need to
be emailed to a list of individuals. The list may change from time to time so
the email addresses for a given Workbook are listed on a separate tab, in
column A.

I want a macro to loop through the list, and add each address to the TO
field of the email. I have the following code which has two problems:
1. It creates a separate email for each address, and I want one email with
everyone on it.
2. The loop is looping through 20 rows, but the number of addresses may vary
from 1 or 2 to more than 20. What I want is for the macro to loop until it
hits a blank row and then stop. So users do not have to maintain the macro,
just the contacts tab.

Here's the code I have:
Sub EmailToContacts()
Dim olApp As Object, olMsg As Object, wb As Workbook, c As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
Set olApp = CreateObject("Outlook.Application")
For Each c In Sheets("Contacts").Range("A1:A20")
Set olMsg = olApp.CreateItem(0)
With olMsg
.To = c.Value
.Subject = "This is a test" 'change as desired
.Body = "A Macro in Excel sent this using Emails in a tab
[Contacts]" 'change as desired
.Attachments.Add ThisWorkbook.FullName 'workbook must be saved
first
.Display 'change to .Send if you don't want displayed,
Redemption will be needed though
End With
Next c
Application.EnableEvents = True
Application.ScreenUpdating = True
Set olApp = Nothing
Set olMsg = Nothing
End Sub