Thursday, 7 May 2015

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")

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
Selection.NumberFormat = "General"
'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.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

No comments:

Post a Comment

Hi User, Thank You for visiting My Blog. Please post your open Feedback only related to this Blog Posts. Please note that I cannot respond to the Anonymous Comments.

Subscribe to Blog Posts by Email

ExcelKingdom-Popular Posts