Como insertar rangos de tablas en el cuerpo de un correo teniendo una macro de envió de correos?

[Luis Fernando 1980]

Buenas Tardes

Tengo una macro que me envía de forma masiva correos a una lista en Excel que ya tengo predeterminada (empresas y Usuarios), pero requiero enviarle a cada uno de las empresas que se encuentren en esta lista una información especifica que tengo en una tabla (encabezados e información) pero no queremos enviarla en tipo texto sino tal cual esta en la tabla de Excel

Adjunto código que utilizo para el envío de los correos

Sub envio_mailprueba()

Application.ScreenUpdating = False

Dim outlookOBJ As Object

Dim mitem As Object

Dim OutMail As Object

Dim fso As Object

Dim ts As Object

Dim strbody As String

Dim Ruta As String

Dim Firma As String

Range("E22").Select

Range(Selection, Selection.End(xlDown)).Select

nume_regi = Selection.Count

Set OutApp = CreateObject("Outlook.Application")

OutApp.Session.Logon

Set OutMail = OutApp.CreateItem(0)

strbody = "Buenos días" & vbNewLine & vbNewLine

Ruta = "C:/Users/lorjuela/AppData/Roaming/Microsoft/Firmas/lUIS FDO ORJUELA.txt"

Set fso = CreateObject("Scripting.FileSystemObject")

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

Firma = ts.readall

ts.Close

On Error Resume Next

For i = 1 To nume_regi

Set outlookOBJ = CreateObject("Outlook.Application")

Set mitem = outlookOBJ.CreateItem(olMailItem)

asunto = Cells(5, 5)

ruta_archivo = Cells(6, 5).Value

Cuerpo = Cells(9, 2)

empresa = Cells(21 + i, 5)

Enviara = Cells(21 + i, 6)

Copia = Cells(21 + i, 7)

With mitem

.To = Enviara

.CC = Copia

.Subject = asunto & " PARA " & empresa

.Body = strbody & Cuerpo & vbNewLine & vbNewLine & vbNewLine & Firma

'.Send

End With

With mitem

.Send

End With

Next i

Range("E5").Select

Application.ScreenUpdating = True

Set outlookOBJ = Nothing

Set mitem = Nothing

MsgBox ("Finalizado se enviaron " & nume_regi & " Correos con exito"), vbOKOnly, "Correos enviados"

Exit Sub

End Sub

En espera de su apreciada ayuda! Mil Gracias