Splitting Excel sheet into multiple Access Tables ?

Sub demo()
  Dim objRS As Object, nwindPath As String
  Set objRS = CreateObject("ADODB.Recordset")
  nwindPath = ThisWorkbook.Path & "\nwind.mdb"
  
  Dim r As Range
  [a1] = "LastName"
  [b1] = "FirstName"
  [a2] = "Hobson"
  [b2] = "Kenneth"
  Set r = [a1:b2]
  r.Name = "MyRange"
 
  objRS.Open "INSERT INTO Employees SELECT * FROM [MyRange] IN '" & ThisWorkbook.FullName & "' 'Excel 8.0;'", _
      "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & nwindPath
 
  Set objRS = Nothing
End Sub

Sub ADO()
'   the Microsoft ActiveX Data Objects 2.x Library
    Dim DBFullName As String
    Dim Cnct As String, Src As String
    Dim Connection As ADODB.Connection
    Dim Recordset As ADODB.Recordset
    Dim Col As Integer, Row As Integer, s As String
    
'   Database information
    'DBFullName = "C:\myfiles\vbabook\Names.mdb"
    DBFullName = "u:\Material\ADO\NWind.mdb"
    
'   Open the connection
    Set Connection = New ADODB.Connection
    Cnct = "Provider=Microsoft.Jet.OLEDB.4.0; "
    Cnct = Cnct & "Data Source=" & DBFullName & ";"
    Connection.Open ConnectionString:=Cnct
    
'   Create RecordSet
    Set Recordset = New ADODB.Recordset
'   Next two lines critical to work in QPro properly.  Excel does not need them.
    Recordset.CursorType = adOpenKeyset
    Recordset.LockType = adLockOptimistic
      
    With Recordset
'       Filter
        Src = "SELECT * FROM Orders "
        'Src = Src & "and CategoryID = 30"
        Recordset.Open Source:=Src, ActiveConnection:=Connection

'   Cells.Clear 'Used in Excel to clear a sheet
'       Write the field names
        'For Col = 0 To .Fields.Count - 1
           'Range("A1").Offset(0, Col).Value = Recordset.Fields(Col).Name   'Excel method
        'Next

If .RecordCount < 1 Then GoTo EndNow 'Query found no matching records
'       Write the recordset by Excel method
        'Range("A1").Offset(1, 0).CopyFromRecordset Recordset
'Add a new record (not pushed to the database until Update)
    MsgBox CStr(.RecordCount), vbInformation, "#Records"
    .AddNew
    Recordset("ShipName") = [Name!A2]
    Recordset("ShipAddress") = [Address!B6]
    Recordset("ShipCity") = Worksheets("City").Range("C3")
    .Update
     MsgBox CStr(.RecordCount), vbInformation, "#Records"
  
  End With
  
    Set Recordset = Nothing
    Connection.Close
    Set Connection = Nothing
End Sub