Boa noite!!

Mas seria do Excel para o Access ou Access para o Excel ?

Sub CraidoXenau()
'Autor: Henry David Thoreau
Dim wb As Workbook
Dim AC As Object
Dim ret As Byte
Const SAVE_PATH As String = "C:myTempAccessUpload.xls"
    
    Worksheets("Sheet1").Copy
    Set wb = ActiveWorkbook
    Application.DisplayAlerts = False
    If CreateObject("Scripting.FileSystemObject").FileExists(SAVE_PATH) Then
        Kill SAVE_PATH
    End If
    wb.SaveAs SAVE_PATH, 56
    wb.Close False
    Application.DisplayAlerts = True
    
    Set AC = CreateObject("Access.Application")
    With AC
        .OpenCurrentDatabase "C:myTempdb1.mdb", False
        ret = .Run("GetXLData")
    End With

End Sub

########

Public Function GetXLData() As Byte
Dim ret As Byte

    On Error GoTo ErrHandler
    ret = 1
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Table1", "C:myTempAccessUpload.xls", True
    ret = 0
    
ErrHandler:
GetXLData = ret
End Function

Leia:
http://www.rondebruin.nl/win/s5/win001.htm

Att

Nomeie uma range do Excel com duas colunas e umas 10 linhas como "tblLojas" (como exemplo) e use esse código

Public Function ConsultaRangeExcel() As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strSQL As String

Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset

cn.ConnectionString = _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=Excel 8.0"

cn.Open
strSQL = "select tbllojas.PRAÇA,tbllojas.codloja from tbllojas where tbllojas.PRAÇA in ('SP')"
Set rs = cn.Execute(strSQL)
rs.MoveFirst
Do Until rs.EOF
Debug.Print rs(0) & "-" & rs(1)
rs.MoveNext
lin = lin + 1
Loop
End Function

Até aqui ele faz um recordset e deixa na memoria (exibe os dados no janela verificação imediata), agora é só criar um conexão com um bd em Access e gravar os dados lá.

Qualquer coisa me avise, que faço essa parte também.