Envia Email con formato de Excel

Te anexo la macro completa, formato en html y con copia de celdas con formato al lugar específico del correo.

Sub Mail_Outlook_With_Signature_Html_1()
'Por.Dante Amor
    Cells.Rows.Hidden = False
    For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
        Set dam = CreateObject("Outlook.Application").CreateItem(0)
        strbody = "<H2><B>Estimado(a).</B></H2>"
        strbody1 = "<H3><B>Con la finalidad de que puedan programar los pagos y evitar contratiempos, envió los recibos de pago a vencer, favor de hacer los pagos antes de la fecha de vencimiento para evitar quedar desprotegidos.</B></H3>"
        FechLim = "<H3><B>Fecha Limite:________Asegurado_______Auto________Aseguradora________Poliza           IMPORTE </B></H3>"
        strbody2 = "<H3><B>Si ya fue realizado favor de hacer caso omiso y favor de mandar una copia del pago para cualquier aclaración.</B></H3>" & _
                  "Cualquier duda quedo a tus ordenes.<br>" & _
                  "<A HREF=""[email protected]"">[email protected]</A>" & _
                  "<br><br><B>Favor de Confirmar la Recepcion</B>"
        If i > 2 Then Rows(i - 1).Hidden = True
        With dam
            .To = Range("B" & i) 'Destinatarios
            .CC = Range("C" & i) 'Con copia
            .BCC = Range("D" & i) 'Con copia oculta
            .Subject = Range("E" & i) '"Asunto"
            .HTMLBody = strbody & strbody1 & FechLim & strbody2
            Range("M1:R1,M" & i & ":R" & i).Copy
            DoEvents
            .display
            DoEvents
            SendKeys "^{Home}"
            DoEvents
            SendKeys "{Down}"
            DoEvents
            SendKeys "{Down}"
            DoEvents
            SendKeys "{Down}"
            DoEvents
            SendKeys "{Down}"
            DoEvents
            SendKeys "^v"
            DoEvents
            .display
            For j = Range("H1").Column To Range("L1").Column
                If Cells(i, j).Value <> "" Then .Attachments.Add Cells(i, j).Value
                DoEvents
            Next
            .display
            DoEvents
        End With
    Next
    Cells.Rows.Hidden = False
    MsgBox "Correos enviados", vbInformation, "SALUDOS"
End Sub

Al final de mi respuesta dice: “Es una buena respuesta” y puedes seleccionar una de 3 opciones:

• Excelente
• Si
• No

Saludos. Dante Amor

No olvides valorar la respuesta.