Sub my1()
    Dim r As Long
    Dim wb As Workbook, wb1 As Workbook, sFT As Worksheet
    Set wb = ThisWorkbook
    Set sFT = wb.Sheets("FT")
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    On Error GoTo erHdl
    For r = 3 To sFT.Cells(sFT.Rows.Count, 1).End(xlUp).Row
        wb.Sheets("Шаблон").Copy after:=wb1.Sheets(wb1.Sheets.Count)
shRdy:  With wb1.Sheets(wb1.Sheets.Count)
            .Name = Left(sFT.Cells(r, 1), 31)
            .Range("C15").Formula = "=" & sFT.Cells(r, 1).Address(external:=True)
            .Range("D15").Formula = "=" & sFT.Cells(r, 23).Address(external:=True)
            .Range("G15").Formula = "=" & sFT.Cells(r, 3).Address(external:=True)
            .Range("H15").Formula = "=" & sFT.Cells(r, 4).Address(external:=True)
            .Range("H16").Formula = "=" & sFT.Cells(r, 5).Address(external:=True)
            .Range("H17").Formula = "=" & sFT.Cells(r, 6).Address(external:=True)
            .Range("H18").Formula = "=" & sFT.Cells(r, 7).Address(external:=True)
            .Range("I15").Formula = "=" & sFT.Cells(r, 8).Address(external:=True)
            .Range("I16").Formula = "=" & sFT.Cells(r, 9).Address(external:=True)
            .Range("I17").Formula = "=" & sFT.Cells(r, 10).Address(external:=True)
            .Range("I18").Formula = "=" & sFT.Cells(r, 11).Address(external:=True)
            .Range("J16").Formula = "=" & sFT.Cells(r, 16).Address(external:=True)
            .Range("K16").Formula = "=" & sFT.Cells(r, 17).Address(external:=True)
            .Range("L15").Formula = "=" & sFT.Cells(r, 12).Address(external:=True)
            .Range("L16").Formula = "=" & sFT.Cells(r, 13).Address(external:=True)
            .Range("L17").Formula = "=" & sFT.Cells(r, 14).Address(external:=True)
            .Range("L18").Formula = "=" & sFT.Cells(r, 15).Address(external:=True)
            .Range("G26").Formula = "=" & sFT.Cells(r, 27).Address(external:=True)
        End With
    Next r
MsgBox "Готово"
GoTo fin

erHdl:
  If Err.Number = 91 Then 'Object variable or With block variable not set
    wb.Sheets("Шаблон").Copy
    Set wb1 = ActiveWorkbook
    Resume shRdy
  End If
  MsgBox "Непредвиденная ошибка" & Err.Number & vbLf & Err.Description, vbCritical

fin:
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
End Sub