Author: Oscar Cronquist Article last updated on January 09, 2018

The macro provided in this blog post let´s you copy table design settings to other tables in the same workbook. Table style options and table style are copied and applied to other tables.

You begin selecting the source table. Run the macro and it shows you each remaining table in your current workbook and asks if you want to apply the same settings.

My message box buttons are in swedish, they are Yes, No and Cancel.

Macro code

Sub CopyTableDesign()

Dim Cell As Range
Dim tblsht As Worksheet
Dim tbl As ListObject
Dim TableName As String, TableStyle As String
Dim Answer As Integer
Dim Headers As Boolean, Totals As Boolean, TableStyleRowStripes As Boolean
Dim TableStyleLastColumn As Boolean, TableStyleColumnStripes As Boolean

On Error GoTo BadBehaviour:
Set Cell = Selection.Range("A1")
TableName = Cell.ListObject.Name
TableStyle = ActiveSheet.ListObjects(TableName).TableStyle
Headers = ActiveSheet.ListObjects(TableName).ShowHeaders
Totals = ActiveSheet.ListObjects(TableName).ShowTotals
TableStyleRowStripes = ActiveSheet.ListObjects(TableName).ShowTableStyleRowStripes
TableStyleLastColumn = ActiveSheet.ListObjects(TableName).ShowTableStyleLastColumn
TableStyleColumnStripes = ActiveSheet.ListObjects(TableName).ShowTableStyleColumnStripes
Set Asheet = ActiveSheet

For Each tblsht In ActiveWorkbook.Sheets
    For Each tbl In tblsht.ListObjects
        Application.Goto tbl.Range
        If tbl.Name <> TableName Then
            Answer = MsgBox("Table: " & tbl.Name & " Apply table design settings?", vbYesNoCancel)
            If Answer = 6 Then
                tbl.TableStyle = TableStyle
                tbl.ShowHeaders = Headers
                tbl.ShowTotals = Totals
                tbl.ShowTableStyleRowStripes = TableStyleRowStripes
                tbl.ShowTableStyleLastColumn = TableStyleLastColumn
                tbl.ShowTableStyleColumnStripes = TableStyleColumnStripes
            ElseIf Answer = 2 Then
                Exit Sub
            End If
        End If
    Next tbl
Next tblsht

Application.Goto Asheet.ListObjects(TableName).Range

Exit Sub

MsgBox Err

End Sub

Download example *.xlsm file

Apply formatting to all tables in workbook.xlsm