Mass emailing with a loop from a list

Hello,

Cant seem to get this code working with a loop.

I want to increment the line in Cells() in each loop.

any help? tx alot!


Sub enviar_email()

Set objeto_outlook = CreateObject("Outlook.Application")

Set Email = objeto_outlook.CreateItem(0)

Email.display


Email.To = Cells(5, 2).Value
Email.cc = Cells(5, 3).Value
Email.BCC = ""

Email.Subject = Cells(5, 4).Value

Email.Body = Cells(5, 5).Value & "," & Chr(10) & Chr(10) _
& Cells(5, 6).Value & Chr(10) & Chr(10) _
& "Boas Vendas!" & Chr(10) & "Joćo"

Email.Attachments.Add (ThisWorkbook.Path & "\Detalhes\" & Cells(5, 4).Value & ".zip")
Email.Send

End Sub