Sub CountRowsInFiles()
    Dim iPath As String, FD As FileDialog, MyFile As String, TempWB As Workbook, TempSht As Worksheet, _
    iFileName As String, iRowsCount As Long, LastRowThisWb As Long, LastRowTempWb As Long
    
    'выбор папки
    Set FD = Application.FileDialog(msoFileDialogFolderPicker)
    With FD
        .AllowMultiSelect = False
        .Title = "Укажите папку с файлами"
        .ButtonName = "Выбрать папку"
        If .Show = False Then Exit Sub Else iPath = .SelectedItems(1) & Application.PathSeparator
    End With
    Set FD = Nothing

    'удаляем всю информацию с текущего листа
    With ThisWorkbook.Worksheets(1)
        .Cells.ClearContents
        .Cells(1, 1) = "Файл": .Cells(1, 2) = "Лист": .Cells(1, 3) = "Последняя строка": .Cells(1, 4) = "Кол-во заполненных в столбце А"
    End With
    
    Application.ScreenUpdating = False
    MyFile = Dir(iPath & "*.xls*")
    Do While MyFile <> ""
        If MyFile <> ThisWorkbook.Name Then
            'Открываем файлы один за другим
            Set TempWB = Workbooks.Open(iPath & MyFile, ReadOnly:=True)
            Set TempSht = TempWB.Worksheets(1)
            With TempSht
                LastRowTempWb = .Cells(.Rows.Count, 1).End(xlUp).Row
            End With
            With ThisWorkbook.Worksheets(1)
                LastRowThisWb = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                .Cells(LastRowThisWb, 1) = TempWB.Name
                .Cells(LastRowThisWb, 2) = TempWB.Worksheets(1).Name
                .Cells(LastRowThisWb, 3) = LastRowTempWb
                .Cells(LastRowThisWb, 4) = WorksheetFunction.CountA(TempSht.Columns(1))
            End With
            TempWB.Close SaveChanges:=False
        End If
        'Следующий файл в папке
        MyFile = Dir
    Loop
    Columns("A:D").AutoFit
    Application.ScreenUpdating = True
    MsgBox "Кол-во строк подсчитаны!", vbInformation, "Конец"
End Sub