title: VBA to Import Multiple worksheets
body: <p>I know there were a lot of different topics to cover this question but nothing that worked for me... I have .xls Workbook with 3 Worksheets in it (Sheet1, Sheet2 and Sheet3).</p>
  
  <p>Each sheet would have 65536 rows in it (Sheet3 would have 25+ lines at the moment). I have found a code on the link below which supposed to do the job... But... it doesn't. It would only import 25k lines. Also, only Sheet1 would have headers, Sheet2 and Sheet3 on a Row1 would have data.</p>
  
  <p><a href="http://www.accessmvp.com/KDSnell/EXCEL_Import.htm#ImpAllWktsSepTbl" rel="nofollow noreferrer">Import Data from All Worksheets in a single EXCEL File into One Table via TransferSpreadsheet (VBA)</a></p>
  
  <p>The VBA I have only imports Excel files from the 1st tab. Is there a way to modify it so it would import all three Worksheets where only the first one has Headers?</p>
  
  <pre><code>    Private Sub cmdButton_Click()
  
  Dim strPathFile As String, strFile As String, strPath As String
  Dim strTable As String
  Dim blnHasFieldNames As Boolean
  
  blnHasFieldNames = True
  strPath = "C:\Folder\"
  strTable = "dbo_tblTest"
  strFile = Dir(strPath &amp; "*.xlsx")
  
  If Right(strPath, 1) &lt;&gt; "\" Then
  strPath = strPath &amp; "\"
  End If
  If Dir(strPath &amp; "*.*") = "" Then
  MsgBox "The folder doesn't contain (visible) files"
  Else
  
  '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' Once purged LOOP file import
  '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  
  Do While Len(strFile) &gt; 0
  strPathFile = strPath &amp; strFile
  DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
          strTable, strPathFile, blnHasFieldNames
  
  
       strFile = Dir()
  Loop
  
  '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' LOOP TO MOVE FILES IN ARCHIVE FOLDER
  '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  
  Dim fso As Object
      Dim FromPath As String
      Dim ToPath As String
      Dim FileExt As String
  
      FromPath = "S:\Folder"  '~~&gt; Change
      ToPath = "S:\Folder\Archive"    '~~&gt; Change
      FileExt = "*"
  
      '~~&gt; You can use *.* for all files or *.doc for word files
  
      If Right(FromPath, 1) &lt;&gt; "\" Then
          FromPath = FromPath &amp; "\"
      End If
      Set fso = CreateObject("scripting.filesystemobject")
      If fso.FolderExists(FromPath) = False Then
          MsgBox FromPath &amp; " doesn't exist"
          Exit Sub
      End If
      If fso.FolderExists(ToPath) = False Then
          MsgBox ToPath &amp; " doesn't exist"
          Exit Sub
      End If
      fso.CopyFile Source:=FromPath &amp; FileExt, Destination:=ToPath
  
      Kill "S:\Folder\*"
      MsgBox "Files Successfully Imported"
  
  End If
  
  End Sub
  </code></pre>