Public myEx As Excel.Application

Dim Name1 As Variant

For Name1 = 1 To Worksheets.Count
    If Worksheets(Name1).Name = "Расчёты" Then
    ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
    End If
Next Name1

Dim Name1 As Variant

For Each Name1 In Sheets
    If Worksheets(Name1).Name = "Расчёты" Then ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
Next 

Dim Name1 As Variant

For Each Name1 In Sheets
    If Worksheets(Name1).Name = "Расчёты" Then Worksheets("Расчёты").UsedRange.Value = Worksheets("Расчёты").UsedRange.Value
Next 

Set fRow5 = Sheets("Лист1").Range(Cells(fRow1, 2), Cells(fRow2, 2)).Find("Искомое", LookAt:=1).Rows

Set fRow5 = Sheets("Лист1").Range(Cells(fRow1, 2), Cells(fRow2, 2)).Find("Искомое", LookAt:=1) 

Set fRow3 = Sheets("Отчет1").Range(Cells(fRow1, 2), Cells(fRow2, 2)).Find("Материальная помощь на погребение", LookAt:=1)If fRow3 Is Nothing ThenElseIf fRow3.Row < fRow2 And Cells(fRow3.Row, 1).Value = "504" Then   List1.Range(Cells(fRow3.Row, ColEnd + 2), Cells(fRow3.Row, ColEnd + 2)).Value = "(-)"End IfEnd If

Set fRow1 = Sheets("Лист1").Columns(2).Find("Всего начислено").Rows

'Для поиска номера строки, в которой начинаются начисления (контрольное слово 1. Начислено)
Private fRow1 As Integer

'Для поиска номера строки, в которой заканчиваются начисления (контрольное слово Всего начислено)
Private fRow2 As Integer

'Поиск номера строки, в которой начинаются начисления, проверка, тот ли файл указан (по слову 1. Начислено)

For fRow1 = 1 To 20
    If Cells(fRow1, 2).Value = "1. Начислено" Then
    Exit For
    End If
Next fRow1

'Если нужного слова нет, значит не тот файл, выводим сообщение и прекращаем макрос
If fRow1 = 21 Then
    MsgBox "Ошибка! Некоректный файл Начислений-Удержаний, программа будет прекращена. Выберите корректный файл ""Свод начислений и удержаний"" и повторите попытку.", vbExclamation, "Упс!"
    End
End If

'Поиск номера строки, в которой заканчиваются начисления, по записи "Всего начислено"
For fRow2 = 20 To 1000
    If Cells(fRow2, 2).Value = "Всего начислено" Then
    Exit For
    End If
Next fRow2

'Поиск номера столбца, в котором расположены Элементы
For ColElem = 1 To 20
    If Cells(ShRowFot, ColElem).Value = "Элемент" Then
    Exit For
    End If
Next ColElem


'Поиск номера столбца, в котором содержится ключевое слово "Графа 7 (всего)"
For ColGr7 = 1 To 20
    If Cells(ShRowFot, ColGr7).Value = "Графа 7 (всего)" Then
    Exit For
    End If
Next ColGr7

List1.Range(Cells(fRow1 + 1, ColEnd + 1), Cells(fRow2 - 1, ColEnd + 1)).Value = "=VLOOKUP(A" & fRow1 + 1 & ",[Справочник.xlsx]Спр1!$A:$F,5,FALSE)"

List1.Range(Cells(fRow1 + 1, ColEnd + 1), Cells(fRow2 - 1, ColEnd + 1)).Value = "=VLOOKUP(A" & fRow1 + 1 & ",[Свод_начисления-удержания_2.0.xlsm]Спр1!$A:$F,5,FALSE)"

ActiveCell.FormulaR1C1 = "=SUMIFS(R[20]C[-6]:R[104]C[-6],R[20]C[-5]:R[104]C[-5],7)"

List1.Cells(1, ColEnd + 6).Value = WorksheetFunction.SumIfs((Range(Cells(fRow1 + 1, ColEnd), Cells(fRow2 - 1, ColEnd))), Range(Cells(fRow1 + 1, ColEnd + 1), Cells(fRow2 - 1, ColEnd + 1)), "7")