复制表代码两次将最后一张表粘贴到新表中两次

时间:2019-07-17 14:14:53

标签: excel vba

为我提供了一些代码,能够在多张工作表上复制表格并将它们粘贴到同一工作簿中现有工作表的1张表格中。我在工作表上创建了一个按钮,数据粘贴到该按钮中以运行代码。现在,由于某种原因,电子表格中的最后一个表格在表格中被粘贴了两次。没有其他表粘贴两次。下面的代码。

Sub CopyTablesToTable1()
    ' Assign worksheets
    Dim sheet2 As Worksheet
    Dim sheet4 As Worksheet
    Dim sheet5 As Worksheet
    Dim sheet6 As Worksheet
    Dim sheet7 As Worksheet
    Dim sheet8 As Worksheet

    With ThisWorkbook
        Set sheet2 = .Worksheets("All_Issues")
        Set sheet4 = .Worksheets("People")
        Set sheet5 = .Worksheets("Customers")
        Set sheet6 = .Worksheets("D&I")
        Set sheet7 = .Worksheets("Ethics")
        Set sheet8 = .Worksheets("Leadership")

    End With

    'Get the table to copy to
    Dim targetTable As ListObject
    Set targetTable = sheet2.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 People Table Copied
    Set srcData = sheet4.ListObjects("table2")
    Call CopyTableData(targetTable, srcData)

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

    ''' Copy the third source D&I table copied
    Set srcData = sheet6.ListObjects("table4")
    Call CopyTableData(targetTable, srcData)

    '''' Copy the fourth source Ethics table copied
    Set srcData = sheet7.ListObjects("table6")
    Call CopyTableData(targetTable, srcData)

    ''''' Copy the fifth source Leadership table copied
    Set srcData = sheet8.ListObjects("table5")
    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

0 个答案:

没有答案