How to loop rows in a range? - excel

Question

I have an Excel sheet with information to send to specific people.
I read a table and when the third column changes value send an email to the first value as a contact in the last column with the table information according to the values in the third column.
An example of the table:
How do I continue the loop and send email to each contact with their personal information.
This code only sends the first information to the first e-mail.
Sub Enviar_Correo()
Dim OutlookApp As Outlook.Application
Dim MItem As Outlook.MailItem
Dim Ultimo As Integer
Dim R As Range
Dim C As Range
Dim inicio As Integer
Dim fin As Integer
Dim contar As Integer
Dim i As Integer
Dim Correo As String
Dim Asunto As String
Set OutlookApp = New Outlook.Application
Ultimo = Cells(Rows.Count, "C").End(xlUp).Row
inicio = 2
contar = 1
For Each R In Range("C2", "C" & Ultimo)
If R.Value = Cells(inicio + 1, 3).Value Then
contar = contar + 1
Else
fin = contar + inicio
Exit For
End If
Next
Dim xRg As Range
Dim xCell As Range
Dim xStr As String
Dim xRow As Long
Dim xCol As Long
Set xRg = Range("D" & inicio, "I" & fin - inicio)
For xRow = 1 To xRg.Rows.Count
For xCol = 1 To xRg.Columns.Count
xStr = xStr & xRg.Cells(xRow, xCol).Value & vbTab
Next
xStr = xStr & vbCrLf
Next
Correo = R.Offset(0, 7)
Asunto = "Envio Cotas"
Set MItem = OutlookApp.CreateItem(olMailItem)
With MItem
.To = Correo
.Subject = Asunto
.Body = "Estimado Proveedor," & vbNewLine & "Hago envío de sus cotas para los próximos días" & vbNewLine & xStr & vbNewLine & "Saludos!"
.Send
'
End With
End Sub