Получение данных из "умной таблицы" в Excel

   Dim oExcel As Excel.Application
        Dim oBook As Workbook
        Dim oSheet As Worksheet
        Dim objListObj As ListObject
        Dim objListCols As ListColumns
        Dim objListRows As ListRows
 
        Dim row As Integer
        Dim col As Integer
 
        'Открыть новую книгу Excel
        oExcel = CreateObject("Excel.Application")
        oBook = oExcel.Workbooks.Open("D:\Хром загрузки\Книга.xlsx")
        oExcel.Visible = True
 
        oSheet = oBook.Worksheets(1)
        objListObj = oSheet.ListObjects(1)
 
        objListCols = objListObj.ListColumns ''' Заголовки
        objListRows = objListObj.ListRows '''' Строчки

Sub ListObjList() 
    Dim ar(), i&, j&
    ar = Workbooks("Книга1.xlsx").Sheets("Лист1").ListObjects(1).Range.Value2
    For i = 1 To UBound(ar, 2)     'столбцы
        For j = 1 To UBound(ar, 1) 'строки
            Debug.Print ar(j, i)
        Next
    Next
End Sub

Sub ListObjList()
    Dim ar, i&, j&
    ar = Workbooks(2).Sheets("Äàííûå").ListObjects(1).Range.Value2
    For i = 1 To UBound(ar, 1)     'строки
        For j = 1 To UBound(ar, 2) 'столбцы
            MsgBox ar(i, j)
        Next
    Next
End Sub

Sub ListObjList2()
    Dim ar(), i&, j&, n&, clNm, arRes()
    ReDim arRes(1000)
    ar = Workbooks(2).Sheets("Äàííûå").ListObjects(1).Range.Value2
    For i = 1 To UBound(ar, 2)    
        clNm = ar(i, 1) & ": "
        For j = 2 To UBound(ar, 1)
            n = n + 1
            arRes(n) = clNm & ar(j, i)
        Next
    Next
    Redim Preserve arRes(0 to n-1)
    MsgBox Join(arRes, vbCr)
End Sub

Sub ListObjList2()
    Dim ar(), i&, n&, arRes(), s$, U&
    ar = Workbooks(2).Sheets("Данные").ListObjects(1).Range.Value2
    U = UBound(ar)
    ReDim arRes(U)
    For i = 2 To U
        arRes(n) = "Заказ = " & ar(i, 1) & ", " & "Высота = " & ar(i, 2) & ", " & "Ширина = " & ar(i, 3)
        n = n + 1
    Next
    s = Join(arRes, vbCr)
    MsgBox s
End Sub