Dim Nstroki As Long
Nstroki = Sheets("Фильтр").Cells(Rows.Count, "A").End(xlUp).Row - 5

.FormulaR1C1 = "=ROW(Фильтр!R3C4:R[" & Nstroki & "]C4)"

.FormulaR1C1 = "=ROW(Фильтр!R3C4:R[" & Nstroki & "]C4)"

Sub Макрос1()
    X = Range("AS5" & Cells(Rows.Count, 1).End(xlDown)).Row
    Range("AS3").FormulaR1C1 = "=ROWS(R[2]C:R[" & X & "]C)"
End Sub

Sub Макрос2()
Dim lLastRow As Long
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("AS3").FormulaR1C1 = "=ROWS(R[2]C:R[" & lLastRow & "]C)"
End Sub

Sub ReplaceAllFormulsFolder()
Dim fd As FileDialog
Dim iPath As String
Dim iFileName As String
Dim iSheet As Worksheet
  
   Set fd = Application.FileDialog(msoFileDialogFolderPicker)
   ChDir "C:\"
   With fd
       .ButtonName = "Выбрать"
       If .Show = -1 Then
           iPath = .SelectedItems(1) & Application.PathSeparator
       Else
           Exit Sub
       End If
   End With
   Set fd = Nothing
      
   If MsgBox("Во всех документах Excel в папке " & iPath & " на всех листах формулы будут заменены на значения!" & Chr(13) & "Вы уверены ???", vbOKCancel + vbExclamation, "Подтверждение") = vbCancel Then Exit Sub
   If MsgBox("Вы отдаёте себе отчёт, что формулы во всех файлах будут удалены?", vbOKCancel + vbExclamation, "Подтверждение") = vbCancel Then Exit Sub
      
   With Application
       .ScreenUpdating = False
       .Calculation = xlCalculationManual
       '.EnableEvents = False
       iFileName = Dir(iPath & "*.xls")
       Do While iFileName$ <> ""
           With Workbooks.Open(Filename:=iPath & iFileName, UpdateLinks:=0) 'ругается!!!
               For Each iSheet In .Sheets
                   With iSheet.UsedRange
                       .Value = .Value
                   End With
               Next
           .Close saveChanges:=True
           End With
           iFileName$ = Dir
       Loop
       .EnableEvents = True
       .Calculation = xlCalculationAutomatic
       .ScreenUpdating = True
   End With
       MsgBox "Во всех документах Excel в папке " & iPath & " на всех листах формулы были заменены на значения!", 64, "Конец"
End Sub

With Workbooks.Open(Filename:=iPath & iFileName, UpdateLinks:=0)

'Извлечение адреса выделенного диапазона
Private Sub CommandButton52_Click()
Dim cell As Range
Dim address As String
    Set cell = Selection
    address = cell.address(External:=True)
    address = Right(address, Len(address) - InStr(1, address, "]"))
End Sub

    Range("O7").Select
    With Selection
       .FormulaR1C1 = address 'вывод адреса в ячейку
    End With

Sub ClearContent()
On Error Resume Next: en& = Err.Number
    Range("A1").Select
    Selection.SpecialCells(xlCellTypeConstants, 21).Select 'выделить все константы, кроме текста
    Selection.ClearContents 'удалить выделенное
    Range("A1").Select
    Selection.SpecialCells(xlCellTypeFormulas, 21).Select  'выделить все формулы, кроме текстовых
    Selection.ClearContents 'удалить выделенное
If en& = 0 Then Err.Clear
End Sub

Sub Camera()
    Dim MyPrompt As String
    Dim MyTitle As String
    Dim UserRange As Range
    Dim OutputRange As Range

    Application.ScreenUpdating = True

    'Prompt user for range to capture
    MyPrompt = "Выберите диапазон для отслеживания!"
    MyTitle = "Выделение диапазона"
    On Error Resume Next
    Set UserRange = Application.InputBox(Prompt:=MyPrompt, _
        title:=MyTitle, Default:=ActiveCell.Address, Type:=8)
    If UserRange Is Nothing Then End
    On Error GoTo 0

    'Copy range to Clipboard as picture
    UserRange.CopyPicture

    'Prompt user for range to paste to
    MyPrompt = "Укажите ячейку для вставки!"
    MyTitle = "Выбор места для камеры"
    On Error Resume Next
    Set OutputRange = Application.InputBox(Prompt:=MyPrompt, _
        title:=MyTitle, Default:=ActiveCell.Address, Type:=8)
    If OutputRange Is Nothing Then End
    On Error GoTo 0

    'Paste picture to output range
    OutputRange.PasteSpecial
    Selection.Formula = UserRange.Address
    
End Sub