Sub СформироватьДокументы()
    Dim ПутьШаблона$, ПутьШаблонаТТН$, НоваяПапка$, Filename$, ФИО$, FindText$, ReplaceText$, msg$, i&, Row As Range, myCell As Range
    
    ПутьШаблона = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, ИмяФайлаШаблона)
    ПутьШаблонаТТН = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, ИмяФайлаШаблонаТТН)
    НоваяПапка = NewFolderName & Application.PathSeparator
    
    Dim EA As Object, ED As Object, ES As Object
    
    Set EA = CreateObject("Excel.Application")
    'Set ED = EA.Workbooks.Add   ' для чего здесь создается новая книга, если она нигде не используется?
    
    For Each Row In ActiveSheet.Rows("3:" & r)
        With Row
            ФИО = "ТТН" & "-" & Trim$(.Cells(1)) & " " & Trim$(.Cells(3))
            Filename = НоваяПапка & ФИО & РасширениеСоздаваемыхФайловТТН
            Set ED = EA.Workbooks.Add(ПутьШаблонаТТН): DoEvents
            For i = 1 To КоличествоОбрабатываемыхСтолбцов
                FindText = Cells(1, i): ReplaceText = Trim$(.Cells(i))
                With ED.Worksheets(1).Range("A1:O78").Cells
                    
                    Set myCell = .Find(What:=FindText, LookIn:=xlFormulas, LookAt:=xlPart, _
                        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False)
                    
                    If Not (myCell Is Nothing) Then
                        .Replace What:=FindText, Replacement:=ReplaceText, LookAt:=xlPart, _
                            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
                    End If
                End With
                DoEvents
            Next i
            ED.SaveAs Filename: ED.Close False: DoEvents
        End With
    Next Row
    EA.Quit
    msg = "Сформировано " & rc & " актов. Все они находятся в папке" & vbNewLine & НоваяПапка
    MsgBox msg, vbInformation, "Готово"
End Sub