Sub Export_The_Data_From_Excel_To_Access()

'Select The Access DataBase file
Dim FileName As String

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

Dim Con As New ADODB.Connection

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

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

With rs
.ActiveConnection = Con 'Activate the connection
.LockType = adLockOptimistic 'Unlock the table to update the records
.Open "Sales" 'Open the marks table in the database

Dim Sh As Worksheet
Set Sh = ActiveWorkbook.Sheets("Sheet2")

Dim R As Long
For R = 2 To Sh.Range("A" & Rows.Count).End(xlUp).Row
.AddNew 'Enables to add the new row in the database

'Allocate the data to respective fields from excel to Access
.Fields("Item") = Sh.Cells(R, 1).Value
.Fields("Quantity") = Sh.Cells(R, 2).Value
.Fields("Price") = Sh.Cells(R, 3).Value
.Fields("Zone") = Sh.Cells(R, 4).Value
.Fields("Period") = Sh.Cells(R, 5).Value
.Update

Next
End With
rs.Save
rs.Close
Con.Close
Set rs = Nothing
Set cn = Nothing
MsgBox ("Hi Inserted the values into the Access Database")
End Sub