如果您有2个名为Workbook1
和Workbook2
的工作簿,并且每个工作簿都有名为reference_table
的相同表(就列而言),并且您要更新reference_table
{来自Workbook 2
的{1}},您如何编写一个完全覆盖Workbook 1
中reference_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
答案 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