Option Explicit 
Sub Access_Data() 
     'Requires reference to Microsoft ActiveX Data Objects xx Library
     
    Dim Cn As ADODB.Connection, Rs As ADODB.Recordset 
    Dim MyConn, sSQL As String 
     
    Dim Rw As Long, Col As Long, c As Long 
    Dim MyField, Location As Range 
     
     'Set destination
    Set Location = [B2] 
     'Set source
    MyConn = "C:\AAA\db1.mdb" 
     'Create query
    sSQL = "SELECT Table1.Data, Table1.Count FROM Table1;" 
     
     'Create RecordSet
    Set Cn = New ADODB.Connection 
    With Cn 
        .Provider = "Microsoft.Jet.OLEDB.4.0" 
        .Open MyConn 
        Set Rs = .Execute(sSQL) 
    End With 
     
     'Write RecordSet to results area
    Rw = Location.Row 
    Col = Location.Column 
    c = Col 
    Do Until Rs.EOF 
        For Each MyField In Rs.Fields 
            Cells(Rw, c) = MyField 
            c = c + 1 
        Next MyField 
        Rs.MoveNext 
        Rw = Rw + 1 
        c = Col 
    Loop 
    Set Location = Nothing 
    Set Cn = Nothing 
End Sub