Hi All,
I have found a code to send emails to multiple recipient based on the sheets name and its contents.
the code is working fine but it require some amendments.
i want to add column E (Email addres (CC) ) also i want to keep the information as a table with the preformatted column widths.
I have attached the sample sheet & image of the required output.
hope someone will help me to find a solution.
Thanks
Sub email_location()
Dim lRow As Long
Dim sBody, y As Long, c
Dim sq(), ar, x As Long, j As Long, jj As Long
lRow = Worksheets("Email Address").Cells(Rows.Count, 4).End(xlUp).Row
For Each c In Worksheets("Email Address").Range("D2:D" & lRow).Cells
sBody = ""
y = 0
x = 0
ReDim sq(x)
ar = Sheets(c.Value).UsedRange
For j = 1 To UBound(ar)
For jj = 1 To UBound(ar, 2)
If ar(j, jj) <> "" Then
ReDim Preserve sq(x)
sq(x) = ar(j, jj)
x = x + 1
End If
Next
Next
sBody = "hi, " & c.Offset(0, -3).Value
Do While y < x
sBody = sBody & vbNewLine & sq(y)
y = y + 1
Loop
With CreateObject("outlook.application").CreateItem(0)
.To = c.Offset(0, -1).Value
.Subject = c.Offset(0, -3).Value & " " & c.Offset(0, -2).Value & " - " & c.Value
.Body = sBody
'.Attachments.Add
.Display '.send
End With
Next
End Sub