Application.Workbooks.Open

=СЧЁТЕСЛИМН(база1!$C:$C;$A3;база2!$H:$H;B$2)

Sub СохранениеПапки()
    Dim rc As Range
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Выбрать папку для сохранения"
        .ButtonName = "Выбрать папку"
        .Filters.Clear
        If .Show = 0 Then Exit Sub
        iDestination = .SelectedItems(1)
    End With
    On Error GoTo ErrHandler
    With CreateObject("Scripting.FileSystemObject")
        For Each rc In Selection.Cells
            URL = FormulaHyperlink(rc) 'превращаю формульные гиперссылки в обычные
            iSource = URL
            If .FolderExists(iSource) Then
                .CopyFolder iSource, iDestination ', True
            End If
        Next
    End With
ErrHandler:
    If Err.Number <> 0 Then
        MsgBox Err.Description, vbCritical, ""
    End If
End Sub
Function FormulaHyperlink(ByRef cell As Range) As String
    If cell.HasFormula And (cell.Hyperlinks.Count = 0) Then
        If cell.Formula Like "=HYPERLINK*" Then
            FormulaHyperlink = Evaluate(Mid$(Split(cell.Formula, ",")(0), 12))
        End If
    End If
End Function

For Each MyCell In MyRange 'Шаг 4: Какое-либо действие с каждой ячейкой
    
Next MyCell

Dim lr as long, lAllCnt as long
lAllCnt = MyRange.Cells.Count
lr = 0
For Each MyCell In MyRange 'Шаг 4: Какое-либо действие с каждой ячейкой
    lr = lr +1
    '.... какие-то действия с ячейкой
    'вывод статус-бара
Next MyCell

ActiveSheet.PageSetup.PrintArea = "A1:AA500"

Dim ph As Picture: Set ph = PicRange.Parent.Pictures.Insert(PicPath)

Dim ph As Shape: Set ph = PicRange.Parent.Shapes.AddPicture(PicPath,msoFalse)

Set ph = PicRange.Parent.Shapes.AddPicture(PicPath,msoFalse)

=SUBSTITUTE(IMPORTXML("https://api.privatbank.ua/p24api/exchange_rates?date="&text(today();"DD.MM.YYYY"); "//exchangerates/exchangerate[@currency='GBP']/@saleRate");".";",")*1