Yuri Watzech

Tentei tudo isso ai =/ Infelizmente não deu haha No idea kkk tks bro! @olliver.soul

@olliver.soul tentei aqui substituir o código, continuou mandando apenas para o primeiro destinatário....... O código ficou assim: 'Email automático em massa para fornecedores - Autor: Yuri Watzech' Sub Enviar_Email() Dim OutlookApp As Object Dim OutlookMail As Object Set OutlookApp = CreateObject("Outlook.Application") Set OutlookMail = OutlookApp.CreateItem(0) On Error Resume Next For i = 3 To 6 If Exemplo1.Range("F" & i).Value <> "Ok" Then With OutlookMail .To = Exemplo1.Range("F" & i).Value .CC = Exemplo1.Range("G" & i).Value .BCC = Exemplo1.Range("H" & i).Value .Subject = Exemplo1.Range("E" & i).Value .HTMLBody = Exemplo1.Range("L" & i).Value .Send '.Display 'Use .Send para enviar o email direto sem exibir na tela'' End With End If Next i On Error GoTo 0 Set OutlookMail = Nothing Set OutlookApp = Nothing End Sub =/

Bom dia a todos! Gostaria de tirar uma dúvida e entender o que estou fazendo de errado no meu código. Estou criando uma Macro para enviar emails em massa para destinatários diferentes, cada um com um texto. Meu problema esta sendo que ele esta enviando somente para a primeira linha da planilha, não está repetindo para os demais. Imagino que seja um Loop faltante, mas pelo fato de ter um "Next i", entendo que funcionaria.... Alguém pode me ajudar? Obrigado!!! Obs: São 4 Emails diferentes (4 Linhas) Código: Sub Enviar_Email() Dim OutlookApp As Object Dim OutlookMail As Object Set OutlookApp = CreateObject("Outlook.Application") Set OutlookMail = OutlookApp.CreateItem(0) On Error Resume Next For i = 1 To 4 If Exemplo1.Range("F" & i + 2).Value <> "Ok" Then With OutlookMail .To = Exemplo1.Range("F" & i + 2).Value .CC = Exemplo1.Range("G" & i + 2).Value .BCC = Exemplo1.Range("H" & i + 2).Value .Subject = Exemplo1.Range("E" & i + 2).Value .HTMLBody = Exemplo1.Range("L" & i + 2).Value .Send '.Display 'Use .Send para enviar o email direto sem exibir na tela'' End With End If Next i On Error GoTo 0 Set OutlookMail = Nothing Set OutlookApp = Nothing End Sub Segue print da planilha: Obrigado desde já!!! =)