Pessoal, esse é meu primeiro post, e esse fórum já me ajudou muito.

Vi um problema semelhante ao meu aqui, mas que não se aplica ao meu.

Fiz a rotina abaixo para enviar no corpo de emails células que se vinculam a uma única célula. Exemplo: um vendedor em A1 tem vários clientes em B1, B2, B3... Ai no email são enviados os dados da célula do vendedor e as células do cliente dele. Acontece que eu queria organizar no corpo do email esses dados variáveis em uma tabela. Alguém pode me dar uma luz?

S

ub EnviarEmails()
Dim cliente(200) As String
Dim meta(200) As String
Dim realizado(200) As String
Dim perrealizado(200) As String
Dim contador As Integer
Dim nome As String
Dim nome_ant As String
Dim body As String
Dim Final As String
Dim Linha As Integer
Dim Email As String
contador = 1
nome = ThisWorkbook.Sheets(1).Cells(2, 1)
nome_ant = ThisWorkbook.Sheets(1).Cells(2, 1)
Email = ThisWorkbook.Sheets(1).Cells(2, 6)
Linha = Sheets("Plan1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
  For i = 2 To Linha
    Do While nome_ant = nome
      cliente(contador) = ThisWorkbook.Sheets(1).Cells(i, 2)
      meta(contador) = ThisWorkbook.Sheets(1).Cells(i, 3)
      realizado(contador) = ThisWorkbook.Sheets(1).Cells(i, 4)
      perrealizado(contador) = ThisWorkbook.Sheets(1).Cells(i, 5)
      i = i + 1
      contador = contador + 1
      nome = ThisWorkbook.Sheets(1).Cells(i, 1)
    Loop
contador = contador - 1
body = "Olá " & nome_ant & "," & vbNewLine & vbNewLine & "Veja a META, REALIZADO e %REALIZADO/META dos seus clientes até ontem:" & vbNewLine & vbNewLine
 For j = 1 To contador
     body = body & " " & cliente(j) & "          " & "R$" & " " & meta(j) & "   " & "R$" & " " & realizado(j) & "   " & "%" & perrealizado(j) & vbNewLine
 Next j
  Envia_Emails Email, body
  nome_ant = nome
  Email = ThisWorkbook.Sheets(1).Cells(i, 6)
  contador = 1
  cliente(contador) = ThisWorkbook.Sheets(1).Cells(i, 2)
  meta(contador) = ThisWorkbook.Sheets(1).Cells(i, 3)
  realizado(contador) = ThisWorkbook.Sheets(1).Cells(i, 4)
  perrealizado(contador) = ThisWorkbook.Sheets(1).Cells(i, 5)
  
  If i <> Linha Then
    i = i - 1
  End If
  Next i
End Sub
Sub Envia_Emails(Email As String, body As String)
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
    With OutlookMail
        .To = Email
        .CC = ""
        .BCC = ""
        .Subject = "CAMPANHA FESTIVAL DE INVERNO - Realizado Clientes"
        .body = body
        .Display
    End With
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
End Sub