Option Explicit

Sub Вытащить_из_выделенных_ячеек()
    Dim cl As Range
    For Each cl In Intersect(Selection, ActiveSheet.UsedRange).Cells
        cl.Cells(1, 2).FormulaR1C1 = "=ВЫТАЩИТЬ(RC[-1])"
        If cl.Cells(1, 2).Value = "" Then cl.Cells(1, 2).Value = Empty
    Next
End Sub

Function ВЫТАЩИТЬ(ByVal строка As String) As Variant
    ВЫТАЩИТЬ = ""
    If InStr(строка, "[""") > 0 Then
        строка = Mid(строка, InStr(строка, "[""") + 2)
    Else
        ВЫТАЩИТЬ = ""
        Exit Function
    End If
    
    If InStr(строка, """]") > 1 Then
        строка = Mid(строка, 1, InStr(строка, """]") - 1)
    Else
        ВЫТАЩИТЬ = ""
        Exit Function
    End If
    
    Dim res As Variant
    res = ""
    строка = Replace(строка, " ", "")
    Dim arr As Variant
    arr = Split(строка, """,""")
    Dim ya As Long
    For ya = LBound(arr) To UBound(arr) - 1
        If (arr(ya) = "-") And (arr(ya + 1) <> "-") Then
            res = arr(ya + 1)
        ElseIf arr(ya + 1) <> "-" Then
            ВЫТАЩИТЬ = ""
            Exit Function
        End If
    Next
    ВЫТАЩИТЬ = res
End Function

Private Const sInitialFileName = "E:\Сервер\Сервер 1\Сервер 2\Сервер 3\Сервер 4\РАБОЧИЕ\Журнал выездов\"
 
Sub Копировать_по_журналам()
    Dim wb As Workbook, c As Range, arrWB(), w
    arrWB = ShowFileDialog()
    With Application
       .EnableEvents = False
       .Calculation = xlCalculationManual
       .ScreenUpdating = False
       .Visible = False
           
        For Each w In arrWB
  
            Set wb = Workbooks.Open(w)  ' Этот метод копирует данные в книги находящиеся по пути с главной
            ThisWorkbook.Worksheets("Средства измерений").Cells.Copy wb.Worksheets("Средства измерений").Cells 'копируем все данные с активного листа
            For Each c In wb.Worksheets("Средства измерений").Cells.SpecialCells(xlCellTypeFormulas, 23)
                c.FormulaLocal = Replace(c.FormulaLocal, "[" & ThisWorkbook.Name & "]", "")
            Next c
            wb.Close (True)
        Next w
           
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .Visible = True
    End With
    MsgBox "Готово"
End Sub
 
Private Function ShowFileDialog() As Variant
    Dim arr As Variant
    Dim sName As String
    sName = Dir(sInitialFileName & "*.xl*")
    Do
        If sName = "" Then Exit Do
        If Left(sName, 2) <> "~$" Then
            If sName <> ThisWorkbook.Name Then
                If IsEmpty(arr) Then
                    ReDim arr(1 To 1)
                Else
                    ReDim Preserve arr(1 To UBound(arr) + 1)
                End If
                arr(UBound(arr)) = sInitialFileName & sName
            End If
        End If
        sName = Dir
        DoEvents
    Loop
    ShowFileDialog = arr
End Function

Range("A100").Resize(ActiveSheet.UsedRange.Rows.Count).UnMerge

Option Explicit
Private Const sInitialFileName = "E:\Сервер\Сервер 1\Сервер 2\Сервер 3\Сервер 4\РАБОЧИЕ\Журнал выездов\"

Sub Копировать_по_журналам()
    Dim wb As Workbook, c As Range, arrWB(), w
    arrWB = ShowFileDialog()
    With Application
       .EnableEvents = False
       .Calculation = xlCalculationManual
       .ScreenUpdating = False
       .Visible = False
          
        For Each w In arrWB
 
            Set wb = Workbooks.Open(w)  ' Этот метод копирует данные в книги находящиеся по пути с главной
            ThisWorkbook.Worksheets("Средства измерений").Cells.Copy wb.Worksheets("Средства измерений").Cells 'копируем все данные с активного листа
            For Each c In wb.Worksheets("Средства измерений").Cells.SpecialCells(xlCellTypeFormulas, 23)
                c.FormulaLocal = Replace(c.FormulaLocal, "[" & ThisWorkbook.Name & "]", "")
            Next c
            wb.Close (True)
        Next w
          
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .Visible = True
    End With
    MsgBox "Готово"
End Sub

Private Function ShowFileDialog() As Variant
    'ShowFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Dim oFD As FileDialog
    Dim lf As Long
    'назначаем переменной ссылку на экземпляр диалога
    Set oFD = Application.FileDialog(msoFileDialogFilePicker)
    With oFD 'используем короткое обращение к объекту
    'так же можно без oFD
    'With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Title = "Выбрать файлы" 'заголовок окна диалога
        .Filters.Clear 'очищаем установленные ранее типы файлов
        .Filters.Add "Excel files", "*.xls*", 1 'устанавливаем возможность выбора только файлов Excel
        '.Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов
        .FilterIndex = 1 'устанавливаем тип файлов по умолчанию - Text files(Текстовые файлы)
        .InitialFileName = sInitialFileName
        .InitialView = msoFileDialogViewDetails 'вид диалогового окна(доступно 9 вариантов)
        If .Show = 0 Then Exit Function 'показывает диалог
        Dim arr As Variant, sName As String
        'цикл по коллекции выбранных в диалоге файлов
        For lf = 1 To .SelectedItems.Count
            sName = fso.GetFileName(.SelectedItems(lf))
            If Left(sName, 2) <> "~$" Then
                If sName <> ThisWorkbook.Name Then
                    If IsEmpty(arr) Then
                        ReDim arr(1 To 1)
                    Else
                        ReDim Preserve arr(1 To UBound(arr) + 1)
                    End If
                    arr(UBound(arr)) = .SelectedItems(lf)  'считываем полный путь к файлу
                End If
            End If
        Next
        ShowFileDialog = arr
    End With
End Function

Range("A100").Resize(ActiveSheet.UsedRange.Rows.Count).UnMerge

вместо
cl.Value = Empty
вставьте 
cl.Value = aValidation.Keys()(0)

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Sheets("Лист2").ListObjects("Таблица2").ListColumns("Колонка2").DataBodyRange) Is Nothing Then
        ВалидэйшнДеКолон
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
    If Not Intersect(Target, Range("A2:A1000")) Is Nothing Then
        If Target.Cells.CountLarge = 1 Then
            With Sheets("Лист2")
                Set Rng = .Columns(1).Find(what:=Target, LookIn:=xlValues, lookAt:=xlWhole)
                If Not Rng Is Nothing Then
                    Target.Offset(0, 1) = Rng.Offset(0, 1)
                Else
                    MsgBox "Такого значения не найдено.", 48, "Ашыпка!"
                    Target.Offset(0, 1) = ""
                End If
            End With
        End If
    End If
End Sub

=ЕСЛИ(СЧЁТЕСЛИМН(A:A;A:A;B:B;"текст3");"текст3";"")

=ИНДЕКС($A$1:$A$8115;ПОИСКПОЗ(СТРОКА();$B$1:$B$8115;0))

=СЧЁТЕСЛИМН(C5:AF5;"Отпуск";D5:AG5;"<>Отпуск")

=B1+(СЧЁТЕСЛИМН(A$1:A2;A2)=1)

=ИНДЕКС(A:A;ПОИСКПОЗ(СТРОКА();B:B;0))

=СМЕЩ($C$1;0;0;МАКС(B:B);1)

=СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(" "&C2;СИМВОЛ(10);ПОВТОР(" ";1000));НАЙТИ(" "&D2&".";ПОДСТАВИТЬ(" "&C2;СИМВОЛ(10);ПОВТОР(" ";1000)))+ДЛСТР(D2)+2;1000))

=СЖПРОБЕЛЫ(ПСТР(ПОДСТАВИТЬ(C2;СИМВОЛ(10);ПОВТОР(" ";1000));НАЙТИ(" "&D2&".";ПОДСТАВИТЬ(C2;СИМВОЛ(10);ПОВТОР(" ";1000)))+3;1000))

="ХР 14 "&ЕСЛИ(ИЛИ(наборка!I16="0";наборка!I16=0);"";наборка!I16&" ")&ЕСЛИ(ИЛИ(наборка!G16="0";наборка!G16=0);"";наборка!G16&" ")&ЕСЛИ(ИЛИ(наборка!H16="0";наборка!H16=0);"";наборка!H16&" ")&ЕСЛИ(ИЛИ(наборка!I17="0";наборка!I17=0);"";наборка!I17&" ")&ЕСЛИ(ИЛИ(наборка!G17="0";наборка!G17=0);"";наборка!G17&" ")&ЕСЛИ(ИЛИ(наборка!H17="0";наборка!H17=0);"";наборка!H17&" ")&ЕСЛИ(ИЛИ(наборка!I18="0";наборка!I18=0);"";наборка!I18&" ")&ЕСЛИ(ИЛИ(наборка!G18="0";наборка!G18=0);"";наборка!G18&" ")&ЕСЛИ(ИЛИ(наборка!H18="0";наборка!H18=0);"";наборка!H18&" ")&ЕСЛИ(ИЛИ(наборка!B3="0";наборка!B3=0);"";наборка!B3&" ")&ЕСЛИ(ИЛИ(наборка!B4="0";наборка!B4=0);"";наборка!B4&" ")

Option Explicit
'v3
Sub ttARM_ActiveWorkbook()
    ttARMwb ActiveWorkbook
End Sub

Sub ttARMwb(wb As Workbook)
    Dim sh As Worksheet
    For Each sh In wb.Sheets
        ttARMsh sh
    Next
End Sub

Sub ttARMsh(sh As Worksheet)
 
Dim Rng As Range
  
For Each Rng In sh.UsedRange.SpecialCells(xlCellTypeFormulas)
    If InStr(Rng.Formula, "INDIRECT") > 0 And Len(Rng.Formula) > 30 Then Rng.Value = Rng.Value
Next
  
End Sub

=ПОВТОР(ЛЕВСИМВ(A1;1);$D$1-ДЛСТР(A1)-ДЛСТР(B1)+1)&ПСТР(A1;2;ДЛСТР(A1)-1)&B1

=ПРАВСИМВ(ПОВТОР(ЛЕВСИМВ(A1);$D$1)&A1&ПРАВСИМВ(B1;$D$1);$D$1)
=ПОВТОР(ЛЕВСИМВ(A1);МАКС(0;$D$1-ДЛСТР(A1)-ДЛСТР(B1)))&ПРАВСИМВ(A1;МАКС(0;$D$1-ДЛСТР(B1)))&ПРАВСИМВ(B1;$D$1)

=СЧЁТЕСЛИМН(A:A;">="&(СЕГОДНЯ()-1+ВРЕМЯ(18;0;0));A:A;"<="&(СЕГОДНЯ()+ВРЕМЯ(6;0;0)))

=СЧЁТЕСЛИМН(A:A;">="&СЕГОДНЯ();A:A;"<="&(СЕГОДНЯ()+ВРЕМЯ(6;0;0)))