Копирование данных из таблицы по порядку в документ-шаблон в определенные ячейки с последующим сохранением раздельно

Sub MMM()
LR = Cells(Rows.Count, 1).End(xlUp).Row
ARR = Range(Cells(2, 1), Cells(LR, 2)).Value
FL = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", 1, "Select Excel file", , False)
    If VarType(FL) = vbBoolean Then
       Exit Sub
    Else
       Debug.Print FL
       Workbooks.Open FL
    End If
    
   For i = 1 To LR - 1
        With Sheets(1)
            .Cells(2, 2).Value = "RZEXT-41289-" & ARR(i, 1)
            .Cells(6, 2).Value = "This letter is issued to confirm that, " _
            & ARR(i, 2) & " complies with Requirement No. 12 c) (i), (ii), and (iii)" _
            & "of Safety Decision 2020-04 FLEXIBILITY PROVISIONS DUE TO NOVEL CORONAVIRUS" _
            & "adopted by the FAA to address the COVID-19 outbreak." _
            & "Therefore, his/her license, rating, certificate, authorisation," _
            & "and endorsement (as appropriate) are extended by 4 months from the date of expiry."
        End With
        ActiveWorkbook.SaveAs Filename:="RZEXT-41289-" & ARR(i, 1) & ARR(2, 1)
   Next
    
    
    
    ActiveWorkbook.Close False
    MsgBox "Job Complete"
End Sub

Sub MMM()
LR = Cells(Rows.Count, 1).End(xlUp).Row
ARR = Range(Cells(2, 1), Cells(LR, 2)).Value
FL = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", 1, "Select Excel file", , False)
    If VarType(FL) = vbBoolean Then
       Exit Sub
    Else
       Debug.Print FL
       Workbooks.Open FL
    End If
    
   For i = 1 To LR - 1
        With Sheets(1)
            .Cells(2, 2).Value = "RZEXT-41289-" & ARR(i, 1)
            .Cells(6, 2).Value = "This letter is issued to confirm that, " _
            & ARR(i, 2) & " complies with Requirement No. 12 c) (i), (ii), and (iii)" _
            & "of Safety Decision 2020-04 FLEXIBILITY PROVISIONS DUE TO NOVEL CORONAVIRUS" _
            & "adopted by the FAA to address the COVID-19 outbreak." _
            & "Therefore, his/her license, rating, certificate, authorisation," _
            & "and endorsement (as appropriate) are extended by 4 months from the date of expiry."
            
            .Cells(6, 2).Characters(Start:=InStr(.Cells(6, 2).Value, ARR(i, 2)), Length:=Len(ARR(i, 2))).Font.FontStyle = "Bold"
            
            
        End With
        ActiveWorkbook.SaveAs Filename:="RZEXT-41289-" & ARR(i, 1) & ARR(2, 1)
   Next
    
    
    
    ActiveWorkbook.Close True
End Sub