Sub данные_close_book()
    Dim sPath As String, sFile As String, sShName As String
    Application.DisplayAlerts = 0
    sPath = "D:\Excle не трогать\8_Visual Managment\"    '"
    sFile = "вытащить данные.xlsx"    '"
    sShName = "Test"    '"


    Worksheets.Add.Name = "Test"
    With Range("a1:N10000")
        .Formula = "='" & sPath & "[" & sFile & "]" & sShName & "'!" & "C5"    '"
        '"A1" - указывается начальная ячейка диапазона, из которого необходимо получить значения

        .Value = .Value

    End With

    Application.DisplayAlerts = 1
End Sub

Sub zapolnit()
    Application.DisplayAlerts = 0
    Dim k           As Long
    k = ActiveWorkbook.Sheets("Критерии").Cells(Rows.Count, "a").End(xlUp).Row
    With Range("b2:b" & k)
        .FormulaR1C1 = "=INDEX(Test!R1C1:R10000C324,MATCH(--Sheet1!RC6,Test!R1C12:R10000C12,0),1)"  ' тут она не корректна,для конкретного примера была верной
        .Value = .Value   '  тут я ловил ошибку Overfloor ,переполнение памяти....
        ActiveWorkbook.Sheets("Test").Delete
        Application.DisplayAlerts = 1
    End With

End Sub

TWB.Sheets("Шаблон").Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False

Sub Путь()
   Dim FilesToOpen
   Dim OpenPath2 As String
    
    OpenPath2 = CStr(ThisWorkbook.Path)
   'ChDrive "C:\Program Files"
    ChDir OpenPath2
    FilesToOpen = Application.GetOpenFilename _
    ("Excel files(*.xlsx),*.xlsx", 1, "Выбрать файл графиков", , False)
    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "Файл не выбран!"
        Exit Sub
    End If
    Cells(13, "C") = FilesToOpen
End Sub
 
Sub Обновить()
    Dim FilesToOpen
    Dim x As Integer
    Application.ScreenUpdating = False  
    Application.DisplayAlerts = False
    OpenPath = ThisWorkbook.Path
    ChDir OpenPath
    Dim C As Range
    Set TWB = ThisWorkbook
    With Sheets("Шаблон")
        lr = .Cells(.Rows.Count, "D").End(xlUp).Row
        If lr > 1 Then .Range("B2:P" & lr).ClearContents
    End With
     Set IWB = Workbooks.Open(Cells(13, "C"))
    With Sheets("Sheet1")
        lr = .Cells(.Rows.Count, "D").End(xlUp).Row
        If lr > 3 Then
            .Range("A2:I" & "K2:P" & lr).Copy
            TWB.Sheets("Шаблон").Range("B2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False     Вот тут он удаляет все формулы которые находятся правее столбца 
        End If
    End With
    IWB.Close
    ActiveWorkbook.RefreshAll
    Sheets("Пульт").Select
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "Обновление ок " vbInformation, "Информация"
End Sub