=ФИЛЬТР(A2:A6;B2:B6<>0)
=ЕСЛИОШИБКА(ФИЛЬТР(A2:A6;B2:B6<>0);"-")

Sub Создать_папки()
Application.ScreenUpdating = False 'Отключаем обновление экрана
Application.EnableEvents = False 'Отключаем отслеживание событий
Application.DisplayAlerts = False 'Отключаем вывод сообщений во время макроса
Dim cell As Range, newPath$
    ' цикл с 4-й по 500-ю с запасом
    For i = 4 To 500
        If Cells(i, 2).Value <> 0 Then
        k = R_S(Cells(i, 2).Value) ' Убираем запрещенные символы имен
            For j = 3 To 12
                ' формируем путь
                newPath$ = Cells(1, 2).Value & k & "\" & Cells(i, j).Value
                ' создаем папки с подпапками
                SHCreateDirectoryEx Application.hwnd, newPath$, ByVal 0&
            Next j
        End If
    Next i
Exit Sub
Application.ScreenUpdating = True    'Включаем обновление экрана
Application.EnableEvents = True    'Включаем отслеживание событий
Application.DisplayAlerts = True    'Включаем вывод сообщений во время макроса
End Sub

#If VBA7 Then        ' Office 2010-2013
        Declare PtrSafe Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" _
        (ByVal hwnd As LongPtr, ByVal pszPath As String, ByVal psa As Any) As LongPtr
#Else        ' Office 2003-2007
    #If Win64 Then
        Declare PtrSafe Function SHCreateDirectoryEx Lib "shell32.dll" Alias "SHBrowseForFolderA" _
        (lpBrowseInfo As BROWSEINFO) As LongPtr
    #Else
        Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" _
        (ByVal hwnd As Long, ByVal pszPath As String, ByVal psa As Any) As Long
    #End If
#End If

Function CreateFolderWithSubfolders(ByVal newPath$) '--- создает папки по пути (Path)
    ' функция получает в качестве параметра путь к папке
    ' если такой папки ещё нет - она создаётся
    ' может создаваться сразу несколько подпапок
    If Len(Dir(newPath$, vbDirectory)) = 0 Then    ' если папка отсутствует
        SHCreateDirectoryEx Application.hwnd, newPath$, ByVal 0&    ' создаём путь
    End If
End Function

Function R_S(ByVal txt As String) As String
    St$ = "~!@/\#$%^&*=|`"""
    For i% = 1 To Len(St$)
        txt = Replace(txt, Mid(St$, i, 1), "_")
    Next
    R_S = txt
End Function

Sub Открыть()
    ПутьКРабочемуСтолу = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    Workbooks.OpenText ПутьКРабочемуСтолу & "\PageText.txt", , , xlDelimited
End Sub

=ПСТР(
ВЕБСЛУЖБА("https://bezbukv.ru/inflect/"&A1);
ПОИСК("родительный";ВЕБСЛУЖБА("https://bezbukv.ru/inflect/"&A1));32767)

=ИЗОБРАЖЕНИЕ("https://www.ejin.ru/wp-content/uploads/2019/05/zakat-zimoj-na-gore.jpg";0;2)

Sub ЗагрузкаСпискаФайлов()
    Dim coll As Collection, ПутьКПапке$, МаскаПоиска$, ГлубинаПоиска%
    ПутьКПапке$ = [C1]    ' берём из ячейки c1
    МаскаПоиска$ = [c2]    ' берём из ячейки c2
    ГлубинаПоиска% = Val([C3])    ' берём из ячейки c3
    If ГлубинаПоиска% = 0 Then ГлубинаПоиска% = 999    ' без ограничения по глубине
    Set coll = FilenamesCollection(ПутьКПапке$, МаскаПоиска$, ГлубинаПоиска%)
    Application.ScreenUpdating = False    ' отключаем обновление экрана
    For i = 1 To coll.Count    ' перебираем все элементы коллекции, содержащей пути к файлам
        НомерФайла = i
        ПутьКФайлу = coll(i)
        ИмяФайла = Dir(ПутьКФайлу)
        Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(, 3).Value = _
        Array(НомерФайла, ИмяФайла, ПутьКФайлу)
        ActiveSheet.Hyperlinks.Add Range("b" & Rows.Count).End(xlUp), ПутьКФайлу, "", _
                                   "Открыть файл" & vbNewLine & ИмяФайла
        DoEvents    ' временно передаём управление ОС
    Next
End Sub

If Cells(i, 1) = "6.3" Or Cells(i, 1) = "9.27" Or Cells(i, 1) = "9.30" Or Cells(i, 1) = "4.2" Or Cells(i, 1) = "2.32" _
Or Cells(i, 1) = "5.3" Or Cells(i, 1) = "12.1" Or Cells(i, 1) = "12.3" Or Cells(i, 1) = "12.9" Or Cells(i, 1) = "12.14" _
Or Cells(i, 1) = "12.15" Or Cells(i, 1) = "12.16" Or Cells(i, 1) = "12.17" Or Cells(i, 1) = "12.18" Or Cells(i, 1) = "12.19" _
Or Cells(i, 1) = "12.22" Or Cells(i, 1) = "12.25" Then

Function ShowFileDialog() As Workbook
    Dim oFD As FileDialog
    Dim x, lf As Long
    'назначаем переменной ссылку на экземпляр диалога
    Set oFD = Application.FileDialog(msoFileDialogFilePicker)
    With oFD 'используем короткое обращение к объекту
    'так же можно без oFD
    'With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Title = "Выбрать файлы" 'заголовок окна диалога
        .Filters.Clear 'очищаем установленные ранее типы файлов
        .Filters.Add "Excel files", "*.xls*;*.xla*", 1 'устанавливаем возможность выбора только файлов Excel
        '.Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов
        .FilterIndex = 1 'устанавливаем тип файлов по умолчанию - Text files(Текстовые файлы)
        .InitialFileName = ThisWorkbook.Name 'назначаем папку отображения и имя файла по умолчанию
        .InitialView = msoFileDialogViewList 'вид диалогового окна(доступно 9 вариантов)
        If oFD.Show = 0 Then Exit Function 'показывает диалог
        'цикл по коллекции выбранных в диалоге файлов
        For lf = 1 To 1 '.SelectedItems.Count
            x = .SelectedItems(lf) 'считываем полный путь к файлу
            Set ShowFileDialog = Workbooks.Open(x) 'открытие книги
            'можно также без х
            'Workbooks.Open .SelectedItems(lf)
        Next
    End With
End Function

For Each Filename In coll
Set WB = Nothing: Set WB = Workbooks.Open(Filename, False, True)
If WB Is Nothing Then    ' не удалось открыть файл
pi.Log vbTab & "ОШИБКА при загрузке файла. Файл не обработан."
Else    ' файл успешно открыт            
   Set sh = WB.Worksheets("Сбор")
   LastRow = WorksheetFunction.CountIf(sh.Range(sh.Cells(4, 2), sh.Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2)), ">" & 0) + 5            
   Set ra = sh.Range(sh.Range("a4"), sh.Range("b" & LastRow + 1)).Resize(, 36)
   ' ==== переносим данные в наш файл (shd - кодовое имя листа, куда помещаем данные)            
   shd.Range("a" & shd.Rows.Count).End(xlUp).Offset(1).Resize(ra.Rows.Count, ra.Columns.Count).Value = ra.Value            
   WB.Close False: DoEvents    ' закрываем обработанный файл без сохранения изменений
   pi.Log vbTab & "Файл успешно обработан."
End If
Next

Dim Phone As String
Dim ReturnValue 'As нужен какой-то для приложения?
Phone = CStr(Cells(3, 2))
ReturnValue = Shell("C:\Users\*****\AppData\Local\Приложение.exe")
Application.Wait (Now + TimeValue("00:00:01")) 'Ждем, когда отработает приложение
ActiveWindow.Application.SendKeys ("{TAB 2}") 'Жмем tab 2 для перехода к номеру
Application.Wait (Now + TimeValue("00:00:01")) 'Ждем, когда отработает приложение
SendKeys (Phone), True 'Тут неожиданный результат

Dim a As String
a = CStr(Cells(1, 3))

ThisWorkbook.FollowHyperlink "https:***="& a

=LET(a;ФИЛЬТР(Скрыть!B1:B50;ПРОМЕЖУТОЧНЫЕ.ИТОГИ(103;ДВССЫЛ("Скрыть!B"&СТРОКА(1:50)))=1);
ЕСЛИОШИБКА(ЧАСТОТА(МАКС(a)+1;a)+a;СУММ(a)))

=ЕСЛИ(A2>999999999.99;"слишком большое число"; ЕСЛИ(ОКРВНИЗ.МАТ(A2;1)=0;"ноль";
ВЫБОР(ЛЕВБ(ТЕКСТ(A2;"000000000.00"))+1;;"сто ";"двести ";"триста ";"четыреста ";"пятьсот ";"шестьсот ";"семьсот ";"восемьсот ";"девятьсот ")
&ВЫБОР(ПСТР(ТЕКСТ(A2;"000000000.00");2;1)+1;;;"двадцать ";"тридцать ";"сорок ";"пятьдесят ";"шестьдесят ";"семьдесят ";"восемьдесят ";"девяносто ")
&ЕСЛИ(--ПСТР(ТЕКСТ(A2;"000000000.00");2;1)<>1;ВЫБОР(ПСТР(ТЕКСТ(A2;"000000000.00");3;1)+1;;"один ";"два ";"три ";"четыре ";"пять ";"шесть ";"семь ";"восемь ";"девять ");
ВЫБОР(ПСТР(ТЕКСТ(A2;"000000000.00");3;1)+1;"десять ";"одиннадцать ";"двенадцать ";"тринадцать ";"четырнадцать ";"пятнадцать ";"шестнадцать ";"семнадцать ";"восемнадцать ";"девятнадцать "))
&ЕСЛИ((--ЛЕВБ(ТЕКСТ(A2;"000000000.00"))+ПСТР(ТЕКСТ(A2;"000000000.00");2;1)+ПСТР(ТЕКСТ(A2;"000000000.00");3;1))>0;"миллион"&ЕСЛИ(ИЛИ(--(ПСТР(ТЕКСТ(A2;"000000000.00");3;1))=0;(--(ПСТР(ТЕКСТ(A2;"000000000.00");3;1))>4);(--(ПСТР(ТЕКСТ(A2;"000000000.00");2;1))=1));"ов ";ЕСЛИ((--ПСТР(ТЕКСТ(A2;"000000000.00");3;1))=1;" ";"а "));"")
&ВЫБОР(ПСТР(ТЕКСТ(A2;"000000000.00");4;1)+1;;"сто ";"двести ";"триста ";"четыреста ";"пятьсот ";"шестьсот ";"семьсот ";"восемьсот ";"девятьсот ")
&ЕСЛИ(--ПСТР(ТЕКСТ(A2;"000000000.00");4;1)=0;;ЕСЛИ(И(--ПСТР(ТЕКСТ(A2;"000000000.00");5;1)=0;--ПСТР(ТЕКСТ(A2;"000000000.00");6;1)=0);"";""))
&ВЫБОР(ПСТР(ТЕКСТ(A2;"000000000.00");5;1)+1;;;"двадцать ";"тридцать ";"сорок ";"пятьдесят ";"шестьдесят ";"семьдесят ";"восемьдесят ";"девяносто ")
&ЕСЛИ(--ПСТР(ТЕКСТ(A2;"000000000.00");5;1)<>1;ВЫБОР(ПСТР(ТЕКСТ(A2;"000000000.00");6;1)+1;;"одна ";"две ";"три ";"четыре ";"пять ";"шесть ";"семь ";"восемь ";"девять ");ВЫБОР(ПСТР(ТЕКСТ(A2;"000000000.00");6;1)+1;"десять ";"одиннадцать ";"двенадцать ";"тринадцать ";"четырнадцать ";"пятнадцать ";"шестнадцать ";"семнадцать ";"восемнадцать ";"девятнадцать "))
&ЕСЛИ((--ПСТР(ТЕКСТ(A2;"000000000.00");4;1)+ПСТР(ТЕКСТ(A2;"000000000.00");5;1)+ПСТР(ТЕКСТ(A2;"000000000.00");6;1))>0;"тысяч"&ЕСЛИ(ИЛИ(--(ПСТР(ТЕКСТ(A2;"000000000.00");5;1))=1;(--(ПСТР(ТЕКСТ(A2;"000000000.00");6;1))>4);(--(ПСТР(ТЕКСТ(A2;"000000000.00");6;1))=0));" ";ЕСЛИ((--ПСТР(ТЕКСТ(A2;"000000000.00");6;1))=1;"а ";"и "));"")
&ВЫБОР(ПСТР(ТЕКСТ(A2;"000000000.00");7;1)+1;;"сто ";"двести ";"триста ";"четыреста ";"пятьсот ";"шестьсот ";"семьсот ";"восемьсот ";"девятьсот ")
&ЕСЛИ(--ПСТР(ТЕКСТ(A2;"000000000.00");7;1)=0;;ЕСЛИ(И(--ПСТР(ТЕКСТ(A2;"000000000.00");8;1)=0;--ПСТР(ТЕКСТ(A2;"000000000.00");9;1)=0);"";""))&
ВЫБОР(ПСТР(ТЕКСТ(A2;"000000000.00");8;1)+1;;;"двадцать ";"тридцать ";"сорок ";"пятьдесят ";"шестьдесят ";"семьдесят ";"восемьдесят ";"девяносто ")
&ЕСЛИ(--ПСТР(ТЕКСТ(A2;"000000000.00");8;1)<>1;ВЫБОР(ПСТР(ТЕКСТ(A2;"000000000.00");9;1)+1;;"один";"два";"три";"четыре";"пять";"шесть";"семь";"восемь";"девять");ВЫБОР(ПСТР(ТЕКСТ(A2;"000000000.00");9;1)+1;"десять";"одинадцать";"двенадцать";"тринадцать";"четырнадцать";"пятнадцать";"шестнадцать";"семнадцать";"восемнадцать";"девятнадцать")))&" руб. "&ПРАВБ(ТЕКСТ(A2;"00.00");2)&" коп.")