Public Sub Файлы_Каталога(ByVal Folder As String, _
                          ByVal sMask As String, ByVal Глубина_Вложенных_Каталогов As Long)
    Dim coll   As Collection
 
    Folder = ThisWorkbook.Path
    If Dir(Folder, vbDirectory) = vbNullString Then

        Err.Raise 567, "Файлы_Каталога", "Не найдена папка «" & Folder & "»"
 
        Exit Sub        ' выход, если папка не найдена
    End If
 
    Set coll = FilenamesCollection(Folder, sMask, _
                                   Глубина_Вложенных_Каталогов)    ' получаем список файлов XLS из папки
 
    If coll.Count = 0 Then

        Err.Raise 567, "Файлы_Каталога", "В папке «" & Split(Folder, "\")(UBound(Split(Folder, "\")) - 1) & "» нет ни одного подходящего файла!"
 
        Exit Sub                ' выход, если нет файлов
    End If
 
    ' перебираем все найденные файлы
    Dim sFile  As Variant
 
    For Each sFile In coll
 
'  Ваша процедура с параметром sFile  
    Next
End Sub

Public Function Ячейка_НЕПустая_Последняя(ByVal ws As Worksheet) _
        As Range
    ' тестом Покрыто опосредованно

    Dim row_Last As Long, col_Last As Long

    row_Last = Строка_Крайняя(ws)

    If row_Last > 0 Then

        col_Last = Диап_Столбец_Крайний( _
                ws.Rows(row_Last).EntireRow)

            Set Ячейка_НЕПустая_Последняя = ws.Cells( _
                    row_Last, col_Last)

    End If
End Function

Public Function Диап_Столбец_Крайний(ByVal r As Range) As Long    ' тестом Покрыто опосредованно
    ' Найти последний столбец с данными, непустой

    On Error Resume Next

    Диап_Столбец_Крайний = _
            r.Find(What:="*", SearchOrder:=xlByColumns, _
            SearchDirection:=xlPrevious).Column

    'If Диап_Столбец_Крайний = 0 Then Диап_Столбец_Крайний = 1

End Function

Public Function Строка_Крайняя(ws As Worksheet) As Long    ' тестом Покрыто опосредованно
    ' Найти последняя строку  с данными, непустую
    On Error Resume Next

    Строка_Крайняя = _
            ws.Cells.Find(What:="*", SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious).Row

    'If Строка_Крайняя = 0 Then Строка_Крайняя = 1

End Function 

Private Sub Red_Alert_Bad()
    ' Вписка сложных формул в столбцы 10, 18, 27
    ' В красных ячейках этих столбцов должна быть специальная формула
    ' её диапазон зависит от смены содержания ячейки в столбце 5

    Dim x As Long, iCol As Long    'arr_Col_Bad() As Variant,
    ' arr_Col_Bad = Array(10, 18, 27)    'Столбцы с плохими формулами

    Dim ws As Worksheet, Row_End As Long
    Set ws = ActiveSheet
    Row_End = Строка_Крайняя(ws)

    With ws
        If .FilterMode Then .ShowAllData
        Dim rng As Range

        Set rng = .Range(.Cells(5, 10), _
                         .Cells(Row_End, Столбец_Крайний(ws)))

        rng.AutoFilter Field:=10, Criteria1:=RGB(255 _
                                                 , 0, 0), Operator:=xlFilterCellColor
        With rng
            'Только видимые
            Set rng = .Resize(.Rows.Count, 1). _
                      SpecialCells(xlCellTypeVisible)
            'Обезопасить от пустых, но красных ячеек
            If WorksheetFunction.CountA(rng) < .Count Then
                .SpecialCells(xlCellTypeBlanks).Value = "0"    'Для xlDown
                'Нули_Одинокие_Заменить_на_Пусто (ws)
            End If
        End With

        If .FilterMode Then .ShowAllData    ' для работы xlDown
        Dim el As Range, Row_Last As Long

        Application.StatusBar = "Ячейки красные: сложные формулы ..."
        For Each el In rng    'прогулка по красным ячейкам
            With el
                Row_Last = .End(xlDown).Row - 1 - .Row
                .FormulaR1C1 = _
                "=IF(RC[-8]=0,0,SUM(RC[-1]:R[" & Row_Last & "]C[-1]))"
                ' столбец 18
                el.Offset(0, .FormulaR1C1 = "=SUM(RC[-1]:R[" & Row_Last & "]C[-1])"
                ' столбец 27
                el.Offset(0, 17).FormulaR1C1 = "=SUM(RC[-1]:R[" & Row_Last & "]C[-1])"
            End With
        Next
    End With
End Sub