Try the following code, which uses the function RangetoHTML by Ron de Bruin...
Option Explicit
Sub test()
Dim OL As Object
Dim MI As Object
Dim HeaderRng As Range
Dim DataRng As Range
Dim LastRow As Long
Dim i As Long
Set OL = CreateObject("Outlook.Application")
Set HeaderRng = Range("b1:e1")
LastRow = Cells(Rows.Count, "a").End(xlUp).Row
Application.ScreenUpdating = False
For i = 2 To LastRow
If Cells(i, "a").Value <> "" Then
Set DataRng = Union(HeaderRng, Range(Cells(i, "b"), Cells(i, "e")))
Set MI = OL.CreateItem(0)
With MI
.To = Cells(i, "a").Value
.Subject = "Your subject here..."
.HTMLBody = RangetoHTML(DataRng)
.Display '.Send
End With
End If
Next i
Application.ScreenUpdating = True
End Sub
Bookmarks