使用vba将单个表格镜像到Excel中的多个工作表

我有一个表中的数据库表中，我想粘贴链接到另一个工作表。 但是我意识到使用excel和vba是不可能的。 有没有办法自动引用这些表格？ 等于单元格范围是我知道的一种方法，但是它非常单调乏味，因为我有超过50个这样的表格。 硬编码这些方程是一个麻烦。这是我已经做了复制粘贴表的基本代码。

Sub table() ActiveSheet.ListObjects("Table1").Range.Copy 'This code will run only when the cursor is at activesheet Sheets("Sheeet2").Range("A2").PasteSpecial xlPasteValues End Sub 

Answer 1

以下是如何将Table Connections添加到新的Workbook以及Refresh表的方法的示例。

代码遍历ListObjects （ Tables ）中的每个ListObject ，添加到新Workbook的连接并将Table放入Worksheet 。
然后创build一个新的Worksheet并处理下一个ListObject 。

您可以更改Workbook和Worksheet名称+path以满足您的需求。

*请注意，对于我来说不明原因的Table在将它们放到新的Worksheet时将其混合起来，但是不会混合Columns 。

AddTableConnectionsToNewWB代码：

 Sub AddTableConnectionsToNewWB() Dim tbl As ListObject Dim tblConn As ListObjects Dim wb As Workbook Application.ScreenUpdating = False Set wb = Workbooks("TableConnections.xlsm") Set tblConn = Workbooks("TestBook3.xlsm").Worksheets("Sheet2").ListObjects For Each tbl In tblConn wb.Connections.Add2 "WorksheetConnection_TestBook3.xlsm!" & tbl, _ "", "WORKSHEET;H:\Projects\TestBook3.xlsm", "TestBook3.xlsm!" & tbl, 7, True, _ False If wb.Worksheets.Count = 1 Then With ActiveSheet.ListObjects.Add(SourceType:=4, Source:=ActiveWorkbook. _ Connections("WorksheetConnection_TestBook3.xlsm!" & tbl), Destination:=Range( _ "$A$1")).TableObject .RowNumbers = False .PreserveFormatting = True .RefreshStyle = 1 .AdjustColumnWidth = True .ListObject.DisplayName = tbl.Name .Refresh End With wb.Worksheets.Add after:=wb.Worksheets(Worksheets.Count) Else With ActiveSheet.ListObjects.Add(SourceType:=4, Source:=ActiveWorkbook. _ Connections("WorksheetConnection_TestBook3.xlsm!" & tbl), Destination:=Range( _ "$A$1")).TableObject .RowNumbers = False .PreserveFormatting = True .RefreshStyle = 1 .AdjustColumnWidth = True .ListObject.DisplayName = tbl.Name .Refresh End With If tblConn.Item(tblConn.Count).Name <> tbl.Name Then wb.Worksheets.Add after:=wb.Worksheets(Worksheets.Count) End If End If Next Application.ScreenUpdating = False End Sub 

刷新代码（这也可以通过点击表格工具中的全部刷新button完成）：

 Sub RefreshTableConnections() Dim wb As Workbook Application.ScreenUpdating = False Set wb = Workbooks("TableConnections.xlsm") wb.RefreshAll Application.ScreenUpdating = True End Sub