Macro to filter and copy table and send mails in outlook


New Member
Apr 4, 2021
Office Version
  1. 2010
  1. Windows
Hi All,
I am trying to create a macro for filtering column A from an excel file and copying the filtered table in Outlook body and sending mails to all people in column A (until the mail is sent o last person). So far i was able to get a code to do this. But i am facing the below challenges.
1) I need to cc the people in column B and C . This should be based on the filtered value. That is all the names corresponding to the filtered values alone should appear in CC.
2) If there are duplicates in column B or in case of column C that should be eliminated. That is if the name "person A" appears twice in column B it should be ccd only once.
3) There are blanks in between column C. That is not all cells in column C have values.

Below is the macro that i have so far. Please help is adding the above points into this. i have added the format of sample mail as image to get a better understanding.

Sub Test()
Dim dic, rng, cel, k
Set rng = Sheets("Sheet1").UsedRange.Offset(1)
Set dic = CreateObject("Scripting.Dictionary")

For Each cel In rng.Columns(1).Cells
If Not dic.exists(cel.Value) Then dic.Add cel.Value, cel.Value
With ActiveSheet
For Each k In dic.keys
.Range("A:H").AutoFilter Field:=1, Criteria1:=k
Call Mail_Sheet_Outlook_Body(dic(k))
Next k
End With
End Sub

Sub Mail_Sheet_Outlook_Body(addr)

Dim rng As Range

Dim OutApp As Object

Dim OutMail As Object

Dim deptName As Variant

With Application

.EnableEvents = False

.ScreenUpdating = False

End With

deptName = Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row).SpecialCells(xlCellTypeVisible).End(xlDown).Value

Set rng = Nothing

Set rng = ActiveSheet.UsedRange

Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)

On Error Resume Next

With OutMail

.To = addr

.CC =

.SentOnBehalfOfName =

.BCC = ""

.Subject = "Pending action reminder"

.HTMLBody = "Dear team" & vbVerticalTab & vbVerticalTab & “blah blab blah “ &RangetoHTML(rng)


End With

On Error GoTo 0

With Application

.EnableEvents = True

.ScreenUpdating = True

End With

Set OutMail = Nothing

Set OutApp = Nothing

End Sub

Function RangetoHTML(rng As Range)

Dim fso As Object

Dim ts As Object

Dim TempFile As String

Dim TempWB As Workbook

TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"


Set TempWB = Workbooks.Add(1)

With TempWB.Sheets(1)

.Cells(1).PasteSpecial Paste:=8

.Cells(1).PasteSpecial xlPasteValues, , False, False

.Cells(1).PasteSpecial xlPasteFormats, , False, False


Application.CutCopyMode = False

On Error Resume Next

.DrawingObjects.Visible = True


On Error GoTo 0

End With

'Publish the sheet to a htm file

With TempWB.PublishObjects.Add( _

SourceType:=xlSourceRange, _

Filename:=TempFile, _

Sheet:=TempWB.Sheets(1).Name, _

Source:=TempWB.Sheets(1).UsedRange.Address, _


.Publish (True)

End With

'Read all data from the htm file into RangetoHTML

Set fso = CreateObject("Scripting.FileSystemObject")

Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)

RangetoHTML = ts.readall


RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _

"align=left x:publishsource=")

'Close TempWB

TempWB.Close savechanges:=False

'Delete the htm file we used in this function

Kill TempFile

Set ts = Nothing

Set fso = Nothing

Set TempWB = Nothing

End Function


  • sample mail.PNG
    sample mail.PNG
    30.6 KB · Views: 8

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.

Watch MrExcel Video

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back