Take a look at the VBA help for "TransferSpreadsheet". It does exactly this.

            John W. Vinson [MVP]

Hi Mario,

Use the transferspreadsheet  method of DoCmd. See a code that opens
multipliple workbooks with multiple worksheets and load them into one table
and adds 4 extra columns, then fill the 4 extra columns with the names of the
workbooks and worksheets.

Private Sub Command2_Click()
'Dim strSheet() As String
'xlsSheetLoop (strSheet())
Dim xlApp As Excel.Application
Dim xlWS As Excel.Worksheet
Dim xlWB As Excel.Workbook
Dim i As Integer
Dim strFileName As String
Dim strOpenFile As String
Dim strNameOnly As String
Dim intTableExistTest As Integer

Dim wkShName As String
Dim objFSO As Object
Dim objFile As Object
Dim strFolderPath As String
Dim strPath As String
Dim strPathBrowser As String
Dim bookName As String
Dim intCellValue As Integer

Dim fieldValue As Field
Dim rangeValue As Range
Dim strFileNameValue As String
Dim workBookName As Names
Dim strFullPath As String
Dim j As Integer
Dim strActiveBook As Object
Dim strDefaultPath As String
Dim strTableNames As String
Dim dtDataTable As DataTable
Dim tbl As ADOX.Table

Dim strSQL As String

Set xlApp = New Excel.Application
On Error Resume Next
''Folder browser function
strDefaultPath = BrowseFolder("Select Folder") & "\"
strPath = strDefaultPath
strFileName = Dir(strPath & "*.xls")
strFullPath = strPath & strFileName

Do While Len(strFileName) > 0

strFullPath = strPath & strFileName
strFileNameValue = strFileName
strNameOnly = Left(strFileName, Len(strFileName) - 4)

Set xlWB = xlApp.Workbooks.Open(strFullPath, , , , "dulan")

For j = 1 To xlApp.Worksheets.Count

Set xlWS = xlApp.ActiveWorkbook.Worksheets(j)
xlWS.Unprotect ("dulan")
wkShName = xlWS.Name
strBudgetCat = Left(wkShName, Len(wkShName) - 6)
strSubCat = Left(wkShName, Len(wkShName) - 5)

DoCmd.TransferSpreadsheet acImport, , "NonVolSen_Table", strFullPath, -1,
wkShName & "!A13:Q33"

DoCmd.RunSQL "ALTER TABLE NonVolSen_Table ADD COLUMN CostCentreCode CHAR,  
GLCode CHAR, BudCat CHAR, SubCat CHAR", -1
strSQL = "UPDATE NonVolSen_Table SET CostCentreCode = '" & strNameOnly & "',
GLCode = '" & wkShName & "', BudCat = '" & strBudgetCat & "', SubCat = '" &
strSubCat & "' WHERE CostCentreCode  IS NULL"
CurrentDb.Execute strSQL, dbFailOnError
Next j

strFileName = Dir()

Set xlWB = Nothing

Loop

End Sub

The BrowseFolder is a Function. Put it in a separate Module and called it.
See the codes of the BrowseFolder:

Option Explicit
'************** Code Start **************
'This code was originally written by Terry Kreft.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code courtesy of
'Terry Kreft

Private Type BROWSEINFO
 hOwner As Long
 pidlRoot As Long
 pszDisplayName As String
 lpszTitle As String
 ulFlags As Long
 lpfn As Long
 lParam As Long
 iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
           "SHGetPathFromIDListA" (ByVal pidl As Long, _
           ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
           "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
           As Long

Private Const BIF_RETURNONLYFSDIRS = &H1
Public Function BrowseFolder(szDialogTitle As String) As String
 Dim X As Long, bi As BROWSEINFO, dwIList As Long
 Dim szPath As String, wPos As Integer

   With bi
       .hOwner = hWndAccessApp
       .lpszTitle = szDialogTitle
       .ulFlags = BIF_RETURNONLYFSDIRS
   End With

   dwIList = SHBrowseForFolder(bi)
   szPath = Space$(512)
   X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)

   If X Then
       wPos = InStr(szPath, Chr(0))
       BrowseFolder = Left$(szPath, wPos - 1)
   Else
       BrowseFolder = vbNullString
   End If
End Function
'*********** Code End *****************

Good luck