Sub InsertTotable()
    Const sCnSql As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="
    Const adOpenStatic = 3
    Const adOpenKeyset = 1
    Const adLockOptimistic = 3
    Const adLockReadOnly = 1
    Dim sCon As String, sSql As String
    Dim Cn As Object
    Dim Sh As Worksheet, rs As Object
    Set Sh = ActiveSheet
    rx = Sh.Range("A2:D100")
    Set Cn = CreateObject("ADODB.Connection")
    MY_Path = "C:\Temp.accdb"
    sCon = sCnSql + MY_Path
    Cn.Open sCon
    If Cn.State <> 1 Then
        MsgBox "Нет связи с файлом access "
        Exit Sub
    End If
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open "SELECT Таблица.* FROM Таблица WHERE 1=-1", Cn, adOpenKeyset, adLockOptimistic
    For n = 1 To UBound(rx)
        rs.AddNew
        For i = 1 To UBound(rx, 2)
            rs(i - 1) = rx(n, i)
        Next
    Next
    rs.Update
    rs.Close
    Cn.Close
    Set rs = Nothing
    Set Cn = Nothing

End Sub