Sub Merge_To_Individual_Files()
'Merges one record at a time to the folder containing the mailmerge main document.
' Sourced from: http://www.msofficeforums.com/mail-merge/21803-mailmerge-tips-tricks.html

'Application.ScreenUpdating = False 'turn of the screen refreshing
Dim StrFolder As String, StrName As String, MainDoc As Document, i As Long, j As Long
Const StrNoChr As String = """*./\:?|"
'
' use the active document with this code
'
Set MainDoc = ActiveDocument
With MainDoc
  StrFolder = .Path & Application.PathSeparator
'
' top of a loop to process the rows in the spreadsheet into documents
'
  For i = 1 To 75
    With .MailMerge
      .Destination = wdSendToNewDocument
      .SuppressBlankLines = True
      With .DataSource
        .FirstRecord = i
        .LastRecord = i
        .ActiveRecord = i
        If Trim(.DataFields("Last_Name")) = "" Then Exit For
        'StrFolder = .DataFields("Folder") & Application.PathSeparator
'
' Build the filename from the spreadsheet merge fields
'
        StrName = .DataFields("Manager_Name") & " " & .DataFields("Last_Name") & "_" & .DataFields("First_Name") & " - 2020 Bonus Adjustment"
      End With
      .Execute Pause:=False
    End With
'
' Remove non-filename characters from the built name
'
      For j = 1 To Len(StrNoChr)
        StrTxt = Replace(StrName, Mid(StrNoChr, j, 1), "_")
      Next
    StrName = Trim(StrName)

'
' save the file to the created name
'
    With ActiveDocument
      .SaveAs FileName:=StrFolder & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
      .Close SaveChanges:=False
    End With

'bottom of a loop to process the rows in the spreadsheet into documents

  Next i

End With


Application.ScreenUpdating = True
End Sub