For Each tek In Dbase.TableDefs
If tek.RecordCount > 0 And tek.Attributes = 0 Then ' кроме пустых и системных
Workbooks(Texcel).Sheets(1).Cells(3, t).Value = tek.Name
t = t + 1
End If
Next tek

Sub TST_Connection2()
    Dim ADOcn As Variant
    Set ADOcn = CreateObject("ADODB.Connection")
    Dim s() As String, i&

     ADOcn.ConnectionString = "Provider=SQLOLEDB;Data Source=T-QCKM5VUY3TRFV;Integrated Security=SSPI;Initial Catalog=TestBase"   
    On Error GoTo CnErrorHandler
    ADOcn.Open
    s = GetAllTableNames(ADOcn)
    For i = 0 To UBound(s)
        Call GetDataDBFromTabl(ADOcn, i, s(i))
    Next i
    ADOcn.Close
    Set ADOcn = Nothing
    Exit Sub
CnErrorHandler:

    For Each ADOErr In ADOcn.Errors
        Debug.Print ADOErr.Number
        Debug.Print ADOErr.Description
    Next
End Sub

Sub GetDataDBFromTabl(ADOcn As Variant, index As Long, sNameTabl As String)
Dim ss As String
    'Set rss = New Recordset
    Set rs = CreateObject("ADODB.Recordset")
    'for changing in recordset
    rs.CursorType = adOpenStatic
    rs.LockType = adLockOptimistic
    
    SQL = "SELECT * From " & sNameTabl
    rs.Open SQL, ADOcn, 1, 1
    If rs.PageCount > 0 Then
        ss = rs.GetString
        Worksheets(index + 5).Cells(1, 1) = ss
    End If
End Sub

Function GetAllTableNames(ADOcn As Variant) As Variant
Dim SQL As String
Dim s As String
    Set rs = CreateObject("ADODB.Recordset")
    'for changing in recordset
    rs.CursorType = adOpenStatic
    rs.LockType = adLockOptimistic
    SQL = "SELECT TABLE_NAME AS [Table names] FROM INFORMATION_SCHEMA.TABLES WHERE table_type='BASE TABLE'"
    rs.Open SQL, ADOcn, 1, 1
    s = rs.GetString
    s = Left(s, Len(s) - 1)
    GetAllTableNames = Split(s, Chr(13))
End Function

   SQL = "SELECT TABLE_NAME AS [Table names] FROM INFORMATION_SCHEMA.TABLES WHERE table_type='BASE TABLE'"
    rs.Open SQL, ADOcn, 1, 1
   Worksheets(1).range("a1").CopyFromRecordset rs