Loop subroutine for every used row using multiple dynamic cell references - email

Question

Basically what I am trying to do is, sending an email for every used row on the target worksheet, each row has the details of the addresses, subject line, table with values etc.
So I can't seem to get it working, as it only dispatches one email from the first target row (2nd row).
I have tried using a combination of For Each and For i = 1 to LR which aren't working. I suspect it is to do with the cell references.
Here is the code:
Sub TestEmail1()
Application.ScreenUpdating = False
Dim aOutlook As Object
Dim aEmail As Object
Dim rngeAddresses As Range, rngeCell As Range, strRecipients As String
Dim ccAddresses As Range, ccCell As Range, ccRecipients As String
Dim rngeSubject As Range, SubjectCell As Range, SubjectContent As Variant
Dim rngeBody As Range, bodyCell As Range, bodyContent As Variant
Dim Table1 As Range
Dim i As Integer
For Each c In ActiveSheet.UsedRange.Columns("A").Cells
Set rng = ActiveSheet.UsedRange
LRow = rng.Rows.Count
For i = 2 To LRow
Set Table1 = Worksheets(1).Range("K1:R1")
Set Table2 = Worksheets(2).Range("K" & i & ":" & "R" & i)
Set aOutlook = CreateObject("Outlook.Application")
Set aEmail = aOutlook.CreateItem(0)
'set sheet to find address for e-mails as I have several people to
'mail to
Set rngeAddresses = ActiveSheet.Range("B" & i)
For Each rngeCell In rngeAddresses.Cells
strRecipients = strRecipients & ";" & rngeCell.Value
Next
Set ccAddresses = ActiveSheet.Range("C" & i)
For Each ccCell In ccAddresses.Cells
ccRecipients = ccRecipients & ";" & ccCell.Value
Next
Set rngeSubject = ActiveSheet.Range("D" & i)
For Each SubjectCell In rngeSubject.Cells
SubjectContent = SubjectContent & SubjectCell.Value
Next
Set rngeBody = ActiveSheet.Range("E" & i)
For Each bodyCell In rngeBody.Cells
bodyContent = bodyContent & bodyCell.Value
Next
'set Importance
'aEmail.Importance = 2
'Set Subject
aEmail.Subject = rngeSubject
'Set Body for mail
'aEmail.Body = bodyContent
aEmail.HTMLBody = bodyContent & "<br><br><br>" & RangetoHTML_ (Table1)
aEmail.To = strRecipients
aEmail.CC = ccRecipients
aEmail.Send
Exit Sub
Next i
Next c
End Sub

Answer 1

There is an Exit Sub at the end of your inner loop that makes the code exit from the procedure after the first iteration:
Sub TestEmail1()
...
For Each c In ActiveSheet.UsedRange.Columns("A").Cells
...
For i = 2 To LRow
...
Exit Sub
Next i
Next c
End Sub
Remove it and processing should continue as desired.