Mirror a single table to multiple sheets in excel using vba

问题

I have one table in the database sheet in which i would want to paste link to another sheet. However i realised that it is not possible using excel and vba. Is there any ways to reference these tables automatically? Equating the cell ranges is one way that i know of but it is extremely tedious because i have over 50 tables of such. Hard coding these equations are a trouble.This is a basic code I have done to copy paste a table .

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

回答1:

Here is an example of how to add Table Connections to a new Workbook and a way to Refresh the tables.

The code steps through each ListObject in ListObjects (Tables), .Add's the connection to the new Workbook and places the Table into the Worksheet.
It then creates a new Worksheet and process the next ListObject.

You can change the Workbook and Worksheet names + path to your needs.

*Do note that for unknown reasons to me the Table mixes the rownumbers up when placing them into the new Worksheet, it however doesn't mix the Columns.

AddTableConnectionsToNewWB code:

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

Refresh code (this can also be done by simply clicking the refresh all button in Table Tools):

Sub RefreshTableConnections()

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


End Sub

来源：https://stackoverflow.com/questions/32391223/mirror-a-single-table-to-multiple-sheets-in-excel-using-vba

标签

vba

excel