Option Explicit
Sub Filter_Data_and_Send_Email_v2()
Dim rg As Range, i As Long
Dim fltr As Range, oDoc As Object
Dim sBody As String
Set rg = Sheet1.Cells(1, 1).CurrentRegion
Set fltr = Sheet2.Cells(1, 1).CurrentRegion
sBody = "Hi There ," & Chr(10) & Chr(10) & "Based on the current day IC balance report for Code #" & Range("A" & i).Value & " and below highlighted are beyond the threshold criteria i.e. $1K." & Chr(10) & Chr(10) & "Please have a look and help clear the below accounts." & Chr(10) & Chr(10) & "Thanks & Regards" & Chr(10) & "Manish "
For i = 2 To rg.Rows.Count
fltr.AutoFilter 1, rg(i, 1).Value2
fltr.SpecialCells(xlCellTypeVisible).Copy
With CreateObject("Outlook.Application").CreateItem(0)
.Display
.To = rg(i, 2).Value2
.Subject = "Report"
.body = sBody
Set oDoc = .GetInspector.WordEditor
With oDoc
.Range(.Range.End - 1, .Range.End - 1).Paste
End With
'.Send
End With
Sheet1.Cells(i, 3).Value = "Sent"
Next i
MsgBox "Controllers Notified !!"
End Sub