Merge Multiple Worksheets from Multiple Workbooks In a Access Table

If you want to merge data from multiple workbooks to single table in access.

Download the File-




Here is the code-

Option Compare Database

Private Sub Command0_Click()
Dim abc As New Excel.Application
Dim wbk As Excel.Workbook
Dim S As String
Dim fldpth
Dim fld, fil As Object
'tool -> reference -> Microsoft Office 12.0 Object Library

' it will open the dialogbox and choose folder in which all workbooks are saved.
Application.FileDialog(msoFileDialogFolderPicker).Title = "Choose Folder"
Application.FileDialog(msoFileDialogFolderPicker).Show
fldpth = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"

Set fso = CreateObject("scripting.filesystemobject")

Set fld = fso.GetFolder(fldpth)
abc.Visible = True
abc.ScreenUpdating = False
abc.DisplayAlerts = False
'it will delete if table already exists.
On Error Resume Next
DoCmd.RunSQL "DROP TABLE " & Me.Text13.Value
For Each fil In fld.Files
If UCase(Right(fil.Path, 4)) = UCase(".xls") Or UCase(Right(fil.Path, 5)) = UCase(".xlsx") Then

Set wbk = abc.Workbooks.Open(fil.Path)
For i = 1 To wbk.Sheets.Count
If wbk.Sheets(i).UsedRange.Count >= 1 Then
DoCmd.TransferSpreadsheet acImport, , Me.Text13.Value, fil.Path, True, wbk.Sheets(i).Name & "!"
End If
Next i

wbk.Close

End If

Next


abc.Visible = True
abc.ScreenUpdating = True
abc.DisplayAlerts = True
Set wbk = Nothing
Set abc = Nothing
Set fso = Nothing
Set fld = Nothing
Set fil = Nothing
AppActivate "Microsoft ACCESS"
End Sub

MS Access Macro http://www.filefactory.com/file/cc9ad49/n/merge_all_worksheet_from_multiple_workbooks_in_a_folder_in_a_single_tables_in_access.accdb


Sample Worksheets http://www.filefactory.com/file/cc9ad4c/n/multiple_worksheets.zip