为我提供了一些代码,能够在多张工作表上复制表格并将它们粘贴到同一工作簿中现有工作表的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