Macro to Email To A List of People

[dwilson38550m]

Hi,

I have created a file which emails to a list of people, however I am having problems with the cc part of the macro code. I need to "cc" to 3 or 4 people but I am struggling with this. I have specified the "cc" list in cell A1 and A2. How can I "cc" to more than person?

Thanks in advance.
-----------------------------------------------------------------------------------------------------------------------

Sub emailgood()
'
' emailgood Macro
'
Sheets("Sheet1").Select
Range("A17").Select


Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range

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

Set sh = Sheets("Sheet1")

Set OutApp = CreateObject("Outlook.Application")

For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")

If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)

With OutMail
.to = cell.Value
.cc = ActiveSheet.Range("A1")
.cc = ActiveSheet.Range("A2")
.Subject = "Aged Sales Ledger Listing **Automatic Email**"
.Body = "Hi, " & vbLf & vbLf & "EMAIL MESSAGE xxxxxxxxxxxx. " & vbLf & vbLf & "Regards," & vbLf & vbLf & " David" & cell.offset(0, 10).Value

For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell

.Send
End With

Set OutMail = Nothing
End If
Next cell

Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub