ActiveWorkbook.Sheets.Count

For Each sh In ActiveWorkbook.Sheets
...
Next sh

rs=.RecordCount

  With Range("A1:B1")
    .CurrentRegion.Resize(, 2).ClearContents
    .Value = Array("Tables", FileName)
    .Resize(rs).Offset(1, 0).Value = Arr
  End With

Range("A2")=rs

With New ADODB.Connection

Sub GetFilePath_GetNameList()
     Dim ws As Worksheet
     Dim wb As Workbook, sShName As String, n As Integer, i As Integer
     Dim Array_Var() As String
          FileName = GetFilePath("Выберите файл")
     If FileName = "" Then Exit Sub
     ActiveSheet.Range("A1") = FileName 'записываем путь выбранного файла в ячейку
      With Application
        .ScreenUpdating = 0 ' обращение к файлу будет происходить в фоновом режиме
        .EnableEvents = 0
        Set wb = .Workbooks.Open(FileName, False, True)
        For i = 1 To ActiveWorkbook.Worksheets.Count 'подсчет количества листов в указанном файле
        ActiveSheet.Cells(2 + i, 14).Value = ActiveWorkbook.Worksheets(i).Name 'запись названий листов по порядку в столбец начиная с 14 в данном случае
        Next i 'Поиск названий в цикле
       wb.Close 0
        .ScreenUpdating = 1
        .EnableEvents = 1
    End With
End Sub