Macro para enviar correo a varios destinatarios

Tengo una tabla de control de vencimientos pero al correr la macro me marca error en tiempo de ejecución marcando en .Send

Sub EnviarEmail()

Dim xOutApp As Object
Dim MItem As Outlook.MailItem
Dim cell As Range
Dim Asunto As String
Dim Correo As String
Dim Destinatario As String
Dim Saldo As String
Dim Msg As String
Set xOutApp = CreateObject("Outlook.Application")
For Each cell In Range("AD6:AD26")
Asunto = "CONTRATO VENCIDO"
Destinatario = cell.Offset(0, -27).Value
Correo = cell.Value
Saldo = Format(cell.Offset(0, -26).Value, "$#,##0")
FechaVencimiento = Format(cell.Offset(0, -26).Value, "dd/mmm/yyyy")
Msg = "Hola buen dia " & vbNewLine & vbNewLine
Msg = Msg & "Me podrias apoyar con el contrato vencido de la bodega de "
Msg = Msg & Destinatario & "." & vbNewLine & vbNewLine
Msg = Msg & "con fecha"
Msg = Msg & FechaVencimiento & vbNewLine & vbNewLine
Msg = Msg & "Quedo en espera de tu pronto apoyo." & vbNewLine
Msg = Msg & "Gracias."
'
Set xOutMail = xOutApp.CreateItem(0)
With xOutMail
.To = Correo
.Subject = Asunto
.Body = Msg
.Send

End With
'
Next
'
End Sub