Prueba con la siguiente para poner la tabla horizontal:
Private Sub Workbook_Open()
'Por.Dante Amor
Set h = Sheets("registro")
For i = 4 To h.Range("A" & Rows.Count).End(xlUp).Row
If LCase(h.Cells(i, "R")) = "si" Then
If h.Cells(i, "A") = Date Or h.Cells(i, "X") = Date Then
Set dam = CreateObject("Outlook.Application").CreateItem(0)
dam.To = h.Range("B" & i).Value 'Destinatarios
dam.Subject = "Aviso de no conformidad"
cuerpo = "Buenos días" & vbCr & _
"Le envío la información del problema encontrado " & _
"para la realización de la acción correctiva en la fecha dada" & vbCr & _
"Cordialmente" & vbCr
'
Set r = h.Range("A" & i & ":Z" & i)
tabla = "<table border><tr>"
'encabezados
For j = 1 To r.Columns.Count
tabla = tabla & "<td>" & h.Cells(3, j) & "</td>"
Next
tabla = tabla & "</tr>"
'registro
For j = 1 To r.Columns.Count
tabla = tabla & "<td>" & h.Cells(i, j) & "</td>"
Next
tabla = tabla & "</tr>"
tabla = tabla & "</table>"
dam.HTMLBody = _
"<HTML> " & _
"<BODY>" & _
"<P>" & cuerpo & tabla & "</P>" & _
"</BODY> " & _
"</HTML>"
'dam.Body =
'dam.Send 'El correo se envía en automático
dam.Display 'El correo se muestra
Set dam = Nothing
End If
End If
Next
MsgBox "Correos enviados"
End Sub
Si no es lo que necesitas, entonces prueba con la siguiente para ver la tabla de forma vertical
Private Sub Workbook_Open()
'Por.Dante Amor
Set h = Sheets("registro")
For i = 4 To h.Range("A" & Rows.Count).End(xlUp).Row
If LCase(h.Cells(i, "R")) = "si" Then
If h.Cells(i, "A") = Date Or h.Cells(i, "X") = Date Then
Set dam = CreateObject("Outlook.Application").CreateItem(0)
dam.To = h.Range("B" & i).Value 'Destinatarios
dam.Subject = "Aviso de no conformidad"
cuerpo = "Buenos días" & vbCr & _
"Le envío la información del problema encontrado " & _
"para la realización de la acción correctiva en la fecha dada" & vbCr & _
"Cordialmente" & vbCr
'
Set r = h.Range("A" & i & ":Z" & i)
tabla = "<table border><tr>"
'encabezados
For j = 1 To r.Columns.Count
tabla = tabla & "<td>" & h.Cells(3, j) & "</td>"
tabla = tabla & "<td>" & h.Cells(i, j) & "</td>"
tabla = tabla & "</tr>"
Next
tabla = tabla & "</tr>"
'registro
'For j = 1 To r.Columns.Count
' tabla = tabla & "<td>" & h.Cells(i, j) & "</td>"
'Next
tabla = tabla & "</tr>"
tabla = tabla & "</table>"
dam.HTMLBody = _
"<HTML> " & _
"<BODY>" & _
"<P>" & cuerpo & tabla & "</P>" & _
"</BODY> " & _
"</HTML>"
'dam.Body =
'dam.Send 'El correo se envía en automático
dam.Display 'El correo se muestra
Set dam = Nothing
End If
End If
Next
MsgBox "Correos enviados"
End Sub
.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.