How to Copy Data from Excel Active Sheet into MS Access Table

Excel VBA Macro to Copy Active Sheet Data to MS Access Table

Sub Excel_2_Access()
Dim WS As Object
Dim SrcSht As Object

Dim AccDb As Object
    
Application.DisplayAlerts = True

Set AccDb = CreateObject("Access.Application")

'Your Database Location
MyDb = "C:\Users\Tamatam\Desktop\Macro_Builder\Test_Database.accdb"

'Specify the Active Sheet from which You wish to Copy Data
'Set SrcSht = ThisWorkbook.Sheets("Data")
'SrcSht.Activate

Set SrcSht = ActiveSheet

'Calling the another Macro to Find the Dynamic Range of Source Data
Call DynUsedRange(MyRange)

'Selecting the Range and Changing the Data Format and the Copying the Data
SrcSht.Range(MyRange).Select
Selection.NumberFormat = "General"
SrcSht.Range(MyRange).Copy
    
'Opening the Target Database File
AccDb.OpenCurrentDatabase MyDb
AccDb.Visible = True

'Opening the Target Table , Pasting the Data then Closing the Table
AccDb.DoCmd.OpenTable "Sales", acViewNormal, acEdit
AccDb.DoCmd.RunCommand acCmdPasteAppend
AccDb.DoCmd.Close acTable, "Sales", acSaveYes

'Closing the Current Database then Quitting the Access Application
AccDb.CloseCurrentDatabase
AccDb.Quit acQuitSaveAll
End Sub
'------------------------------------------------------------------------------'
'Defining the Dynamic Used Range below and Calling this Macro to Above Macro
Sub DynUsedRange(ByRef MyRange)
        Dim DataLastCell As Object
        Dim WS As Worksheet
        Dim MyRng
        
        Set WS = ActiveSheet
   
    'To Find the Last Row Number with data in the Range
    Set DataLastCell = WS.Cells.Find("*", WS.Cells(1, 1), , , xlByRows, xlPrevious)
        RC = DataLastCell.Row
          
    'To Find the Last Column Number with data in the Range
    Set DataLastCell = WS.Cells.Find("*", WS.Cells(1, 1), , , xlByColumns, xlPrevious)
        CC = DataLastCell.Column
        
    'To Find the End of the Range in  Data
        DR = DataLastCell.Address

   'Defining the Dynamic Range      
   Set MyRng = WS.Range("A1:" & DR)
         MyRange = MyRng.Address
End Sub

--------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional
--------------------------------------------------------------------------------------------------------