Sub Копировать_по_журналам()
    Dim wb As Workbook, c As Range, arrWB(), w
    arrWB = Array("Журнал1.xlsm", "Журнал2.xlsm", "Журнал3.xlsm", "Журнал4.xlsm", "Журнал5.xlsm", "Журнал6.xlsm", "Журнал7.xlsm", "Журнал8.xlsm")
    With Application
       .EnableEvents = False
       .Calculation = xlCalculationManual
       .ScreenUpdating = False
       .Visible = False
         
        For Each w In arrWB

            Set wb = Workbooks.Open("E:\Сервер\Сервер 1\Сервер 2\Сервер 3\Сервер 4\РАБОЧИЕ\Журнал выездов" & "\" & 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

Sub Perenos()
Const H = "H"
Dim j As Variant
Dim iLR_A As Long
Dim iLastRow As Long
  For Each j In Array(2, 4)
    iLR_A = Cells(Rows.Count, H).End(xlUp).Row + 1
    iLastRow = Cells(Rows.Count, j).End(xlUp).Row
    Range(Cells(1, j), Cells(iLastRow, j)).Cut Cells(iLR_A, H)
  Next
  iLR_A = Cells(Rows.Count, H).End(xlUp).Row
  For j = iLR_A To 1 Step -1
    If IsEmpty(Cells(j, H)) Then Rows(j).Delete
  Next
End Sub

Sub Perenos()
Dim j As Integer
Dim iLR_A As Long
Dim iLastRow
  For j = 2 To 5
    iLR_A = Cells(Rows.Count, "A").End(xlUp).Row + 1
    iLastRow = Cells(Rows.Count, j).End(xlUp).Row
    Range(Cells(1, j), Cells(iLastRow, j)).Cut Cells(iLR_A, 1)
  Next
  iLR_A = Cells(Rows.Count, "A").End(xlUp).Row
  For j = iLR_A To 1 Step -1
    If IsEmpty(Cells(j, 1)) Then Rows(j).Delete
  Next
End Sub

Sub Протянуть_формулу()
    With Sheets("Лист1")
    [C8].Resize(Cells(Rows.Count, "B").End(xlUp).Row - 7, 1).FormulaR1C1 = "=IF(RC[-1]=1,""Нет"",""Да"")"
        End With
End Sub

Sub Кнопка1_Щелчок()
If InputBox("Введите пароль") <> "123" Then MsgBox "неправильный пароль": Exit Sub
Ваш макрос
End Sub