CODEWITHSUNDEEP
vbaexcel
Fiztban
Fiztban

Reputation: 275

VBA macro to overwrite data from one table to another

If you have 2 workbooks called Workbook1 and Workbook2 and each have identical tables (in terms of columns) called reference_table and you want to update the reference_table of Workbook 2 from that of Workbook 1, how would you write a macro that completely overwrites the reference_table in Workbook 2?

The reason a complete overwrite is needed is because the new refernce_table could be smaller than the one needing to be updated.

So far I have been adapting code, but I don't know how to interact with tables.

Sub Overwrite()
    Dim fso As FileSystemObject
    Dim fldBase As Folder
    Dim fWb As File

    Dim wsOrigin As Worksheet
    Dim newData As Name
    Dim newRng As Range

    Dim refWb As Worksheet
    Dim oldData As Name
    Dim oldRng As Range

    'Get current version of Table1
    Set wsOrigin = ThisWorkbook.Worksheets("Sheet1")  '<-- adjust to your ws name in Dashboard
    Set newData = wsOrigin.Names("Table1") '<-- Origin table name
    Set newRng = newData.RefersToRange

    'Set current workbooks file location as base
    Set fso = New FileSystemObject
    Set fldBase = fso.GetFolder(ThisWorkbook.Path)

    For Each fWb In fldBase.Files
        If fWb.Name = "Worksheet2.xls*" Then

            'Open Worksheet that needs upodating
            Set refWb = Application.Workbooks.Open(Filename:=fWb.Path, ReadOnly:=False)
            Set oldData = refWb.Names("Table1") '<-- Table name
            Set oldRng = oldData.RefersToRange

            'Old data removed
            oldData.DataBodyRange.Delete

            'Add new data
            oldRng = newRng.Value

            'Close and save updated file
            'refWb.Close SaveChanges:=True

        End If

    Next

End Sub

Upvotes: 0

Views: 3197

Answers (1)

Storax
Storax

Reputation: 12207

You possible should read this

For your poblem this might help

Sub CopyToWks(wks1 As Worksheet, wks2 As Worksheet, tblName As String)

    Dim tbl1 As ListObject
    Dim tbl2 As ListObject
    Dim rg As Range

    Set tbl1 = wks1.ListObjects(tblName)
    Set rg = tbl1.Range

    Set tbl2 = wks2.ListObjects(tblName)
    tbl2.Delete

    rg.Copy wks2.Range("A1")

End Sub

A test could look like that

Sub testIt()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim wks1 As Worksheet
Dim wks2 As Worksheet

    Set wb1 = Workbooks("WB1.XLSM")
    Set wks1 = wb1.Sheets(1)
    Set wb2 = Workbooks("WB2.XLSM")
    Set wks2 = wb2.Sheets(1)

    CopyToWks wks1, wks2, "Table1"

End Sub

Upvotes: 1

Related Questions