Sub iDateBaseTableValue()
    Dim iConnection As Object
    Dim irecordset As Object
    Dim iPath$, iSelect$, Cnct$, i%, lrow&
    On Error Resume Next
    Set iConnection = CreateObject("ADODB.Connection")
   Set irecordset = CreateObject("ADODB.Recordset")
   
    ' путь к базе данных
    iPath = ThisWorkbook.Path & "\" & "Имя БД"
    
    ' данные для подключения к БД
    Cnct = Join(Array("Provider=Microsoft.ACE.OLEDB.12.0", "Data Source=" & iPath), ";")
    'подключение к БД
    iConnection.ConnectionString = Cnct
    iConnection.Open
    
    With irecordset
        ' Запрос SQL
      iSelect = "Select * From [Имя таблицы] Where  'Условие'"
        .Open iSelect, iConnection
        For i = 1 To .Fields.Count
            Лист1.Cells(1, i).Value = .Fields(i - 1).Name
        Next i
    End With
   Activesheet.Range("a2").CopyFromRecordset irecordset
End Sub