将表格上的表格中的行复制到另一张表格上的表格末尾

时间:2019-06-21 15:23:27

标签: excel vba

我已经进行了数天的研究,找不到这样做的VBA。我想获取其他工作表上的行,并将其粘贴到底部1张工作表中的1张表中。

示例: 工作表1有一个表格“ table1”。 工作表2包含一个数据为“ table2”的表 表格3包含一个数据为“ table3”的表

我要获取数据(没有标题的整个表),将其复制并粘贴到表末尾的sheet1上的“ table1”中。然后,我将复制并粘贴sheet3和其他代码。我很想让它工作1张,更不用说多张了。谢谢!

1 个答案:

答案 0 :(得分:1)

我假设您的所有工作表1至3都在同一工作簿中。如果没有更改,ThisWorkbook指向工作表“ 2”和“ 3”所在的任何工作簿。我还假定您的表大小都相同。

Sub CopyTablesToTable1()
    ' Assign worksheets
    Dim sheet1 As Worksheet
    Dim sheet2 As Worksheet
    Dim sheet3 As Worksheet
    With ThisWorkbook
        Set sheet1 = .Worksheets("Sheet 1")
        Set sheet2 = .Worksheets("Sheet 2")
        Set sheet3 = .Worksheets("Sheet 3")
    End With

    'Get the table to copy to
    Dim targetTable As ListObject
    Set targetTable = sheet1.ListObjects("table1")

    If Not targetTable.DataBodyRange Is Nothing Then _
        targetTable.DataBodyRange.Delete '' clear out table 1 data and rows

    Dim srcData As ListObject
    Dim targetRange As Range


    ' Get the first Source Table Copied
    Set srcData = sheet2.ListObjects("table2")
    Call CopyTableData(targetTable, srcData)

    '' Copy the second source table copied
    Set srcData = sheet3.ListObjects("table3")
    Call CopyTableData(targetTable, srcData)


End Sub

Sub CopyTableData(targetTable As ListObject, srcData As ListObject)

    '' If the target table already has data
    If Not targetTable.DataBodyRange Is Nothing Then
        '' top left part of the range
        '' targetTable.DataBodyRange.End(xlDown).Offset(1, 0)

        '' Bottom Right part of the range
        '' targetTable.DataBodyRange.End(xlDown).Offset(srcData.DataBodyRange.Rows.Count, srcData.DataBodyRange.Columns.Count - 1)
        Set targetRange = Range(targetTable.DataBodyRange.End(xlDown).Offset(1, 0), _
                                targetTable.DataBodyRange.End(xlDown).Offset(srcData.DataBodyRange.Rows.Count, srcData.DataBodyRange.Columns.Count - 1))

    Else '' If the target table is empty

        '' top left part of target
        ''targetTable.HeaderRowRange.Cells(1,1).offset(1,0)

        '' Bottom right part of the target range
        '' targetTable.HeaderRowRange.Cells(1, 1).Offset(srcData.DataBodyRange.Rows.Count, srcData.DataBodyRange.Columns.Count - 1)

        Set targetRange = Range(targetTable.HeaderRowRange.Cells(1, 1).Offset(1, 0), _
                                targetTable.HeaderRowRange.Cells(1, 1).Offset(srcData.DataBodyRange.Rows.Count, srcData.DataBodyRange.Columns.Count - 1))

    End If

    ' Copy the data
    targetRange.Value = srcData.DataBodyRange.Value

End Sub