Sub ttARM3()
    Dim wbOld As Workbook
    Set wbOld = ActiveWorkbook
    Dim ActiveSht As Worksheet
    Dim Rng As Range
    
    For Each ActiveSht In wbOld.Sheets
        On Error Resume Next
        Set Rng = ActiveSht.UsedRange.SpecialCells(xlCellTypeFormulas)
        On Error GoTo 0
        
        If Not Rng Is Nothing Then
            For Each Rng In Rng
                If InStr(Rng.Formula, "INDIRECT") > 0 And Len(Rng.Formula) > 30 Then
                    Rng.Value = Rng.Value
                End If
            Next Rng
        End If
    Next ActiveSht
End Sub

Sub ttARM()  

Dim Rng As Range
 
For Each Rng In ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)  
If InStr(Rng.Formula, "VLOOKUP") > 0 Then Rng.Value = Rng.Value  
End If  
 
Next  
 
End Sub  

xFdItem

Open (xFdItem & xFileName) For Binary As #xFileNum

fPath

Open (fPath & xFileName) For Binary As #xFileNum

Sub Sbor_imen_failov_i_stranic()
    Dim i As Long
    Dim xRg As Range
    Dim xStr As String
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Dim xFileNum As Long
    Dim RegExp As Object
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.pdf", vbDirectory)
        Worksheets.Add.Name = "Приложения"
        Set xRg = Sheets("Приложения").Range("A1")
        Range("A:B").ClearContents
        Range("A1:B1").Font.Bold = True
        xRg = "Имя файла"
        xRg.Offset(0, 1) = "Кол-во страниц"
        i = 2
        xStr = ""
        Do While xFileName <> ""
            Cells(i, 1) = xFileName
            Set RegExp = CreateObject("VBscript.RegExp")
            RegExp.Global = True
            RegExp.Pattern = "/Type\s*/Page[^s]"
            xFileNum = FreeFile
            Open (xFdItem & xFileName) For Binary As #xFileNum
                xStr = Space(LOF(xFileNum))
                Get #xFileNum, , xStr
            Close #xFileNum
            Cells(i, 2) = RegExp.Execute(xStr).Count
            i = i + 1
            xFileName = Dir
        Loop
        Columns("A:B").AutoFit
    End If
End Sub

Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator

Sub Подготовка_удалить_колонки()
  
'Первая часть макроса: Перемещаем листы в новую книгу
Dim ActiveSht As Worksheet
'Dim NewWb As Workbook
Dim wbOld As Workbook, wbNew As Workbook
For Each wbOld In Workbooks
wbOldname = ActiveWorkbook.name
For Each ActiveSht In ThisWorkbook.Worksheets
ActiveSht.Visible = True ' делаем скрытые листы видимыми в исходной книге.
Next
   
Sheets(Array("Исходные данные", "Сопровод", "ПЗ МЭР", "ПЗ", "КЦ", "Справочник", "СПЕЦОС ОК", "СПЕЦОС ПК")).Move ' Здесь указываете имена нужных листов
Set NewWb = ActiveWorkbook
For Each ActiveSht In NewWb.Worksheets
With ActiveSht.UsedRange
.Value = .Value
End With
Next
'NewWb.SaveAs FileName:="C:\" & "Копия.xls" ' листов стало много - какое имя нужно давать для книги не знаю.
'MsgBox "Формы документов перенесены в новую книгу и сохранены.", vbInformation
'ThisWorkbook.Close SaveChanges:=False
  
  
'Вторая часть макроса: удаление внешних связей
   'Dim wbOld As Workbook, wbNew As Workbook
    'Set wbOld = ActiveWorkbook
     
    'Set wbNew = Workbooks.Add(1)
    Windows(wbOldname).Activate
      
exist_links = ActiveWorkbook.LinkSources(xlExcelLinks)
 
If Not IsEmpty(exist_links) Then
For i = LBound(exist_links) To UBound(exist_links)
' MsgBox exist_links(i)
ActiveWorkbook.BreakLink name:=exist_links(i), Type:=xlLinkTypeExcelLinks
Next
Else
MsgBox "Связей не найдено"
End If
  
'Третья часть макроса: Настройка формата под себя
    Dim wb As Workbook
    Set wb = ActiveWorkbook
    'Sheets("Исходные данные").UsedRange.Value = Sheets("Исходные данные").UsedRange.Value
    'Sheets("ПЗ МЭР").UsedRange.Value = Sheets("ПЗ МЭР").UsedRange.Value
    'Sheets("ПЗ").UsedRange.Value = Sheets("ПЗ").UsedRange.Value
    Application.DisplayAlerts = False
    'Sheets("Справочник").Delete
    Application.DisplayAlerts = True
    'Sheets("КЦ").Visible = xlSheetsHidden
    Sheets("Ф.1(1д)").Visible = xlSheetHidden

'Первая часть макроса: Перемещаем листы в новую книгу
Dim ActiveSht As Worksheet
Dim NewWb As Workbook
For Each ActiveSht In ThisWorkbook.Worksheets
ActiveSht.Visible = True ' делаем скрытые листы видимыми в исходной книге.
Next
  
Sheets(Array("Исходные данные", "Сопровод", "ПЗ МЭР", "ПЗ", "КЦ", "Справочник")).Move ' Здесь указываете имена нужных листов
Set NewWb = ActiveWorkbook
For Each ActiveSht In NewWb.Worksheets
With ActiveSht.UsedRange
.Value = .Value
End With
Next
'NewWb.SaveAs FileName:="C:\" & "Копия.xls" ' листов стало много - какое имя нужно давать для книги не знаю.
MsgBox "Формы документов перенесены в новую книгу и сохранены.", , ""
'ThisWorkbook.Close SaveChanges:=False

'Вторая часть макроса: удаление внешних связей
exist_links = ActiveWorkbook.LinkSources(xlExcelLinks)
 
If Not IsEmpty(exist_links) Then
For i = LBound(exist_links) To UBound(exist_links)
' MsgBox exist_links(i)
ActiveWorkbook.BreakLink name:=exist_links(i), Type:=xlLinkTypeExcelLinks
Next
Else
MsgBox "Связей не найдено"
End If

  Dim wbOld As Workbook, wbNew As Workbook    Set wbOld = ActiveWorkbook
     
    Set wbNew = Workbooks.Add(1)
     
    Dim exist_links As Variant
    exist_links = wbOld.LinkSources(xlExcelLinks)
    If Not IsEmpty(exist_links) Then
        Dim i As Long
        For i = LBound(exist_links) To UBound(exist_links)
            ' MsgBox exist_links(i)
            wbOld.BreakLink Name:=exist_links(i), Type:=xlLinkTypeExcelLinks
        Next
    Else
        MsgBox "Связей не найдено", vbExclamation
    End If
     
    'Как активировать?
    'Активировать - бэд практик, ну да ладно.
    wbOld.Activate
    MsgBox ActiveWorkbook.Name, vbInformation
    wbNew.Activate
    MsgBox ActiveWorkbook.Name, vbInformation

'Вторая часть макроса: удаление внешних связей
exist_links = ActiveWorkbook.LinkSources(xlExcelLinks)
 
If Not IsEmpty(exist_links) Then
For i = LBound(exist_links) To UBound(exist_links)
' MsgBox exist_links(i)
ActiveWorkbook.BreakLink name:=exist_links(i), Type:=xlLinkTypeExcelLinks
Next
Else
MsgBox "Связей не найдено"
End If

Sub Подготовка_удалить_колонки()

'Первая часть макроса: Перемещаем листы в новую книгу
Dim ActiveSht As Worksheet
Dim NewWb As Workbook
For Each ActiveSht In ThisWorkbook.Worksheets
ActiveSht.Visible = True ' делаем скрытые листы видимыми в исходной книге.
Next
 
Sheets(Array("Исходные данные", "Сопровод", "ПЗ МЭР", "ПЗ", "КЦ", "Справочник")).Move ' Здесь указываете имена нужных листов
Set NewWb = ActiveWorkbook
For Each ActiveSht In NewWb.Worksheets
With ActiveSht.UsedRange
.Value = .Value
End With
Next
'NewWb.SaveAs FileName:="C:\" & "Копия.xls" ' листов стало много - какое имя нужно давать для книги не знаю.
MsgBox "Формы документов перенесены в новую книгу и сохранены.", , ""
'ThisWorkbook.Close SaveChanges:=False


'Вторая часть макроса: удаление внешних связей
exist_links = ActiveWorkbook.LinkSources(xlExcelLinks)

If Not IsEmpty(exist_links) Then
For i = LBound(exist_links) To UBound(exist_links)
' MsgBox exist_links(i)
ActiveWorkbook.BreakLink name:=exist_links(i), Type:=xlLinkTypeExcelLinks
Next
Else
MsgBox "Связей не найдено"
End If

'Третья часть макроса: Настройка формата под себя
    Set wb = ActiveWorkbook
    'Sheets("Исходные данные").UsedRange.Value = Sheets("Исходные данные").UsedRange.Value
    'Sheets("ПЗ МЭР").UsedRange.Value = Sheets("ПЗ МЭР").UsedRange.Value
    'Sheets("ПЗ").UsedRange.Value = Sheets("ПЗ").UsedRange.Value
    Application.DisplayAlerts = False
    Sheets("Справочник").Delete
    Application.DisplayAlerts = True
    'Sheets("КЦ").Visible = xlSheetsHidden
    Sheets("Ф.1(1д)").Visible = xlSheetsHidden
...

Sheets("A").Range("D14", Cells(Rows.Count, "X").End(xlUp).Offset(, 3)).Value = Sheets("A").Range("D14", Cells(Rows.Count, "X").End(xlUp).Offset(, 3)).Value

Sheets("B").Range("D14", Cells(Rows.Count, "X").End(xlUp).Offset(, 3)).Value = Sheets("B").Range("D14", Cells(Rows.Count, "X").End(xlUp).Offset(, 3)).Value

Sub Тест_выделения_диапозона()
Sheets("A").Range("D14", Cells(Rows.Count, "X").End(xlUp).Offset(, 3)).Value = Sheets("A").Range("D14", Cells(Rows.Count, "X").End(xlUp).Offset(, 3)).Value
Sheets("B").Range("D14", Cells(Rows.Count, "X").End(xlUp).Offset(, 3)).Value = Sheets("B").Range("D14", Cells(Rows.Count, "X").End(xlUp).Offset(, 3)).Value
End Sub

Application.DisplayAlerts = 0

Sub Auto_Open()
Workbooks.Open Filename:="...\СцепитьЕсли2.xlam"
End Sub