VBA宏将数据从一个表覆盖到另一个表

时间:2018-06-17 12:34:00

标签: vba excel-vba excel

如果您有2个名为Workbook1Workbook2的工作簿,并且每个工作簿都有名为reference_table的相同表(就列而言),并且您要更新reference_table {来自Workbook 2的{​​1}},您如何编写一个完全覆盖Workbook 1reference_table的宏?

需要完全覆盖的原因是因为新Workbook 2可能小于需要更新的refernce_table

到目前为止,我一直在调整代码,但我不知道如何与表进行交互。

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

1 个答案:

答案 0 :(得分:1)

您可以阅读this

对于你的问题,这可能会有所帮助

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

测试看起来像那样

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