Can you adapt this looping code to fit your requirements? Start by testing it by itself before you start adding your extra code. It appears you have code included in your sample which may not be required with this approach.
Code:
Public Sub Merge_To_Individual_Files()
Dim StrFolder As String, MainDoc As Document, i As Long
Set MainDoc = ActiveDocument
StrFolder = MainDoc.Path & "\"
With MainDoc.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
.ViewMailMergeFieldCodes = False
With .DataSource
.ActiveRecord = wdFirstRecord
Do Until i = .ActiveRecord 'next record didn't go forward
MainDoc.SaveAs FileName:=StrFolder & i & "temp.pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
i = .ActiveRecord
.ActiveRecord = wdNextRecord
Loop
End With
End With
End Sub