Copy tables to another worksheet

Question

I have 2 tables, "Table1" and "Table2" in Worksheet(1).

I would like to copy these tables to another worksheet(2) where the top left corner of Table1 is in the new worksheet at cell "A1" and the Top left corner cell of Table2 is in the new worksheet at cell "O1."

Unless the ActiveCell is A1 in Sheet2, the tables won't copy and paste correctly. Am I not activating a sheet correctly?

Sub CopyTables()
Worksheets(2).Activate          'must be on ExHouStorm or Worksheet(1)
Worksheets(1).ListObjects("Table1").Range.Copy
Worksheets(2).Paste


Worksheets(1).ListObjects("Table2").Range.Copy
Worksheets(2).Range("O1").Select
Worksheets(2).Paste

End Sub

This seems pretty simple as it partially works but I think I have a syntax mistake.

Answer 1

I know this is an old thread, but I needed something similar recently and took the time to write a generalized version that uses a param array to handle the targets.

The param array consists of pairs of data where the first element is either a worksheet object (e.g. Sheet1) or worksheet name (e.g. "Sheet2") and the second element is the associated target address (e.g. "B2").

Copying to another open workbook is supported by prefixing the target worksheet name with the open workbook name bracketed by [] (e.g. "[Book1]Sheet1").

    '/// <summary>
    '/// Method CopyExcelTables.
    '///    Copies all Excel table(s) (ListObjects) from the SourceSheet to TargetSheet(s).
    '///    TargetSheet(s) are defined via a TargetInfo param array which consists of pairs
    '///        of values, where the first item is a TargetSheet or TargetSheet Name and
    '///        the second item is the associated target Range Address.
    '///    The TargetSheet can be in another open WorkBook, in which case the TargetSheet
    '///        name is [Other open Workbook name]Target Sheet Name.
    '///
    '/// Sample calls:
    '///    ' Copies 2 Excel tables to other worksheets within the same workbook.
    '///    Call CopyExcelTables(Sheet1, "Sheet2", "A1", Sheet3, "C3")
    '///    ' Copies 2 Excel tables to another worksheet within the same workbook and
    '///    ' also to a worksheet contained in another open workbook
    '///    Call CopyExcelTables(Sheet1, "Sheet2", "A1", "[book1]Target Sheet", "D4")
    '/// </summary>
    '/// <param name=SourceSheet - The worksheet that contains the Excel tables to be copied.>Excel worksheet>WorkSheet</param>
    '/// <param name=TargetInfo - Param array containing pairs of data, the first is a WorkSheet or Worksheet Name and the second is the target Cell address.>Variant()</param>
    Public Sub CopyExcelTables(oSourceSheet As Worksheet, ParamArray vTargetInfo() As Variant)
    Dim oExcelTable As ListObject
    Dim oTargetSheet As Worksheet
    Dim lIndex As Long
    Dim sTargetSheetName As String, sTargetSheetRange As String
    Dim vTargets As Variant, vTarget As Variant
        If Not ValidateParamArray(oSourceSheet, vTargets, CVar(vTargetInfo)) Then
            Exit Sub
        End If
        
        With oSourceSheet
            lIndex = 0
            For Each oExcelTable In .ListObjects
                vTarget = vTargets(lIndex)
                Set oTargetSheet = vTarget(0)
                sTargetSheetRange = vTarget(1)
                ''Call oExcelTable.Range.Copy(Destination:=vTarget(0).Range(vTarget(1)))
                Call oExcelTable.Range.Copy(Destination:=oTargetSheet.Range(sTargetSheetRange))
                ''Debug.Print lIndex + 1; oExcelTable.Parent.Name; "    "; oTargetSheet.Parent.Name; "    "; oTargetSheet.Name; "    "; sTargetSheetRange
                lIndex = lIndex + 1
            Next
        End With

        Set oTargetSheet = Nothing: Set oExcelTable = Nothing
    End Sub
    
    Private Function ValidateParamArray(oSourceSheet As Worksheet, vTargets As Variant, vTargetInfo As Variant) As Boolean
    Dim oTargetSheet As Worksheet
    Dim oParentWorkbook As Workbook
    Dim oTargetWorkbook As Workbook
    Dim lIndex As Long
    Dim sTarget As String, sTargetSheetName As String, sTargetSheetRange As String, sTargetBookName As String
    Dim vTarget As Variant
        With oSourceSheet
            Set oParentWorkbook = oSourceSheet.Parent
            
            If .ListObjects.Count = 0 Then
                Call MsgBox("Source sheet " & .Name & " contains no Excel tables (ListObjects).", vbOKOnly Or vbCritical, "Missing Source")
                Exit Function
            ElseIf UBound(vTargetInfo) = -1 Then
                Call MsgBox("No copy target(s) specified.", vbOKOnly Or vbCritical, "Missing Target")
                Exit Function
            ' Param array is zero based.
            ElseIf UBound(vTargetInfo) Mod 2 = 0 Then
                Call MsgBox("Target param array must contain an even number of elements.", vbOKOnly Or vbCritical, "Invalid Target")
                Exit Function
            ' Param array is zero based.
            ElseIf .ListObjects.Count <> ((UBound(vTargetInfo) + 1) / 2) Then
                Call MsgBox("Source count " & .ListObjects.Count & " does not equal Target count " & (UBound(vTargetInfo) + 1) / 2 & ".", vbOKOnly Or vbCritical, "Count Mismatch")
                Exit Function
            End If
            
            ' Parse the param array, which is zero based and create an array of arrays where
            ' element [0] is the target worksheet and element[1] is the associated target range.
            ReDim vTargets((UBound(vTargetInfo) - 1) / 2)
            
            For lIndex = LBound(vTargetInfo) To UBound(vTargetInfo) Step 2
                sTargetBookName = vbNullString
                
                ' Support either a target sheet name or the actual target worksheet.
                If TypeName(vTargetInfo(lIndex)) = "String" Then
                    sTarget = vTargetInfo(lIndex)
                    If InStr(sTarget, "]") = 0 Then
                        sTargetSheetName = sTarget
                    Else
                        sTargetBookName = Replace$(Left$(sTarget, InStr(sTarget, "]") - 1), "[", vbNullString)
                        sTargetSheetName = Mid$(sTarget, InStr(sTarget, "]") + 1)
                    End If
                    
    On Error Resume Next
                    If sTargetBookName = vbNullString Then
                        Set oTargetSheet = oParentWorkbook.Sheets(sTargetSheetName)
                    Else
                        Set oTargetWorkbook = Workbooks(sTargetBookName)
                        If oTargetWorkbook Is Nothing Then
                            Call MsgBox("Target workbook " & sTargetBookName & " is not open.", vbOKOnly Or vbCritical, "Invalid Target")
                            Exit Function
                        End If
                        Set oTargetSheet = oTargetWorkbook.Sheets(sTargetSheetName)
                    End If
                    If oTargetSheet Is Nothing Then
                        Call MsgBox("Target worksheet " & sTargetSheetName & " does not exist.", vbOKOnly Or vbCritical, "Invalid Target")
                        Exit Function
                    End If
    On Error GoTo 0
                Else
                    Set oTargetSheet = vTargetInfo(lIndex)
                End If
                
                sTargetSheetRange = vTargetInfo(lIndex + 1)
                
                ReDim vTarget(1)
                Set vTarget(0) = oTargetSheet
                vTarget(1) = sTargetSheetRange
                
                vTargets(lIndex / 2) = vTarget
            Next
        End With
        
        ValidateParamArray = True

        Set oTargetSheet = Nothing: Set oParentWorkbook = Nothing: Set oTargetWorkbook = Nothing
    End Function

Answer 2

Another method, simpler and shorter:

Range("Table1[#All]").copy Range("L1")

Answer 3

You should be able to copy directly by providing the destination.

Sub CopyTables()

    Worksheets(1).ListObjects("Table1").Range.Copy _
        Destination:=Worksheets(2).Range("A1")


    Worksheets(1).ListObjects("Table2").Range.Copy _
        Destination:=Worksheets(2).Range("O1")

End Sub

By directly and explicitly addressing the objects and their destinations, you can avoid .Activate and .Select altogether.

See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.