Merge data from multiple sheets form multiple workbooks in separate tables in MS Access

If you want to merge data from different worksheets from various workbooks into separate tables in access.

For Example - I have taken three workbooks with rep names and all three workbooks is having four sheets "Nort","South","East", and "West". You want to merge data from all sheet name north from all workbook into single table, etc.





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
'*********************** delete all tables exisitng in database **************************8
Dim TblName As String
Dim obj As AccessObject, dbs As Object
Set dbs = Application.CurrentData
For Each obj In dbs.AllTables
TblName = obj.Name
If Not (Left(TblName, 4)) = "MSys" Then
Access.DoCmd.DeleteObject acTable, obj.Name
End If
Next obj

'**********************choose folder having all the workbooks***************************************

'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

For Each fil In fld.Files
' will search for excel files only
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, , wbk.Sheets(i).Name, 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 dbs = nothing
Set wbk = Nothing
Set abc = Nothing
Set fso = Nothing
Set fld = Nothing
DoCmd.SetWarnings True
AppActivate "Microsoft ACCESS"
End Sub


Access Macro File http://www.filefactory.com/file/cc9b86d/n/merge_all_worksheet_from_multiple_workbooks_in_a_folder_in_a_seperate_tables_in_access.accdb


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