Download the Workbook

Public TableNames As String, CancelSub As String

Sub Split_The_Master_DataBase_Into_Multiple_Tables()

' Import The Liabraries
'Microsoft Access 16.0 Object Liabrary
'Microsoft Active X Data Objects 6.1 Liabrary

'Define The Varaible to select the Access DataBase file
Dim FileName As String

'Save The Access DB file path into the variable
FileName = Application.GetOpenFilename()

'Define the variable to establish the ADODB Connection
Dim Con As New ADODB.Connection

'Define the connection String
Con.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & FileName & ";" & _
"User Id=admin;Password="
'Open the connection
Con.Open

'Define Record Set variable
Dim rs As New ADODB.Recordset

'Open the Record set with the help of SQL Query
With rs
.ActiveConnection = Con 'Activate the connection
.Open "Select Distinct Item from Sales"
End With

'Add all the unique records to the listbox of the Userform
Do Until rs.EOF
UserForm1.ListBox1.AddItem rs.Fields(0).Value
rs.MoveNext ' enables to move to next row in the Access Table
Loop

'Nullify the Record set
Set rs = Nothing

'display the Userform
UserForm1.Show

'Exit the Program if the user clicks on CANCEL button in userform
If CancelSub = "Yes" Then
Exit Sub
End If

'Split the Table Name by using ;
PostSplitTableNames = Split(TableNames, ";")

'Define the variable to create the table name
Dim TblName As String

'Using the for loop to create the tables based on selected items in List box
For TNumb = 0 To UBound(PostSplitTableNames)
'Save the table name into the variable
TblName = PostSplitTableNames(TNumb)

'Define the variable to create record set
Dim SalesRs As New ADODB.Recordset

With SalesRs
'Activate the connection
.ActiveConnection = Con
'Open the record set
.Open "Select * from Sales where Item = '" & TblName & "'"
End With

'Create table by using sequel(SQL) syntax
Con.Execute "Create table " & TblName & " (Item varchar (15),Quantity int, Price int, Region varchar(11), Period int)"

'Loop through Record set

Do Until SalesRs.EOF
'Save the data into respective variables
Item = SalesRs.Fields(0).Value
Quantity = SalesRs.Fields(1).Value
Price = SalesRs.Fields(2).Value
Region = SalesRs.Fields(3).Value
Period = SalesRs.Fields(4).Value

'Insert the values into the table
Con.Execute "insert into " & TblName & " values ('" & Item & "', " & Quantity & ", " & Price & ", '" & Region & "', " & Period & ")"
' Moves to next row in record set
SalesRs.MoveNext
Loop

'Nullify the record set variable
Set SalesRs = Nothing
Next
'Close the connection
Con.Close
'nullify the variable memory
Set Con = Nothing
'Automation completion message
MsgBox ("Hi Copied the data into respective tables in Access Database")
End Sub