Ускорение замены связей (ссылок) в Excel

...
Set wbTemplate = Workbooks.Open( _
Filename:=templatePath, _
ReadOnly:=True, _ ' ← только для чтения
IgnoreReadOnlyRecommended:=True) ' без лишнего диалога
' вставить
Application.Calculation = xlCalculationAutomatic 'если вставить эту строку уменьшение времени с 365 секунд 
'до 180 секунд - в 2 раза
'  Заменяем ТОЛЬКО эту ссылку на новый файл
    On Error GoTo ChangeLinkError
    wbTemplate.ChangeLink Name:=oldLink, NewName:=newLink, Type:=xlExcelLinks
    On Error GoTo 0
... 
'  Сохраняем копию
 wbTemplate.SaveAs fileName:=newFileName, FileFormat:=xlOpenXMLWorkbook 
....

Sub Конс_Перевязка_свод()
    Dim wb_Cel  As Workbook, wb_Tek  As Workbook
    Dim i As Integer, j As Integer, God As Integer, Kvart As Integer
    Dim Uslovie As Integer
    Dim Prefix As String, Fayl(11) As String, Fayl_Old(11) As String, F_Suf As String, F_Suf_Old As String
    Dim PERIOD As String, Period_Old  As String
    Uslovie = 0
    For Each wb_Tek In Workbooks
        Select Case LCase(Left(wb_Tek.name, 9))
            Case "конс_свод", "_конс_сво"
                Set wb_Cel = wb_Tek
                Uslovie = 1
            Case Else
        End Select
    Next
    If Uslovie < 1 Then
          MsgBox "Не обнаружен открытый файл: Конс_свод_..."
          Exit Sub
    End If
    Prefix = ActiveWorkbook.path & "\"
    F_Suf = Right(wb_Cel.name, 18)
    PERIOD = Mid(F_Suf, 6, 6)
    God = Val(Left(PERIOD, 4))
    Kvart = Val(Mid(PERIOD, 6, 1))
    Select Case Kvart
        Case 1
            If Month(Now) >= 9 Then
               F_Suf_Old = Left(F_Suf, 5) & Format(God - 1) & "_4кв.xlsx" ' типовая строка
            Else
               F_Suf_Old = Left(F_Suf, 5) & Format(God - 1) & "_3кв.xlsx" ' нетипичная замена
            End If
        Case Else
            F_Suf_Old = Left(F_Suf, 10) & Format(Kvart - 1) & "кв.xlsx"
    End Select
    Fayl(1) = "Конс_БЗ"
    Fayl(2) = "Конс_БЗОТ"
    Fayl(3) = "Конс_БП"
    Fayl(4) = "Конс_БПДР"
    Fayl(5) = "Конс_БПР"
    Fayl(6) = "Конс_себест"
    Fayl(7) = "Конс_БЗЗ"
    Fayl(8) = "Конс_БДР"
    Fayl(9) = "Конс_БДР_бух"
    Fayl(10) = "Конс_БЗ1"
    Fayl(11) = "Конс_БЗ2"
    For j = 1 To 11
        Fayl_Old(j) = Fayl(j) & F_Suf_Old
        Fayl(j) = Fayl(j) & F_Suf
    Next j
    Application.Calculation = xlCalculationManual
    For j = 1 To 11
        Workbooks.Open filename:=Prefix & Fayl(j), UpdateLinks:=0
        wb_Cel.ChangeLink name:=Prefix & Fayl_Old(j), NewName:=Prefix & Fayl(j), Type:=xlExcelLinks
        ActiveWorkbook.Close savechanges:=False
    Next j
    Application.Calculation = xlCalculationAutomatic
    wb_Cel.Save
End Sub