Pessoal preciso fazer com que esta range vai com a mesma formatação para o e-mail
Help!

Sub EnviarEmail()

Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

emailpara = Sheets("Mapa").Range("B5").Value
emailcopia = Sheets("Mapa").Range("B6").Value
emailTitulo = Sheets("Mapa").Range("B3").Value

Set rng = Nothing
On Error Resume Next

Set rng = Sheets("E-mail").Range("b3:Q37").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If

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

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = emailpara
.CC = emailcopia
.BCC = ""
.Subject = emailTitulo
.HTMLBody = Sheets("E-mail").Range("S1") + RangetoHTML(rng)
.display

End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub