Vba 单击按钮Excel 2013根据单元格值将行从一个Excel表复制到另一个Excel表

我是VBA的新手，一直在努力查找以下任何现有信息：

我有一个工作簿（excel 2013），其中有一个包含数据/文本等的表格（excel表格），如主项目列表。在其他几张纸上，我有类似的表格，数据相似，但子项目除外。我想做的是在主项目列表（第一张图纸）的主页面上单击按钮，单击按钮后，它将检查其他图纸（子项目）上的表，查看第1列中是否有“是”的行，并将每一行（有“是”）复制到主项目表中的下一个可用行。第2列中有一个唯一的引用，必须选中该引用，以避免重复行

我已经开始玩弄我在这里找到的一些代码，但它是用来复制到一个新的工作表，而不是一个表，显然这只是我试图实现的功能的一部分

Sub Button2_Click()
Dim r As Long, endRow As Long, pasteRowIndex As Long

endRow = 10
pasteRowIndex = 1

For r = 1 To endRow

    If Cells(r, Columns("B").Column).Value = "yes" Then
    Rows(r).Select
    Selection.Copy

    'Switch to the sheet where you want to paste it & paste
    Sheets("Sheet2").Select
    Rows(pasteRowIndex).Select
    ActiveSheet.Paste

    'Next time you find a match, it will be pasted in a new row
    pasteRowIndex = pasteRowIndex + 1


    'Switch back to your table & continue to search for your criteria
    Sheets("Sheet1").Select
    End If
Next r
End Sub

---

对这方面的任何帮助都是非常值得赞赏的。

这里有两件重要的事情要考虑：

如何将一行从一个表添加到另一个表

如何确定表中是否已经存在该行

向表中添加新行 表格可以为您节省一些工作，因为您不必查找最后一行。要从

范围

对象向表中添加新行，可以按照以下示例函数的行进行操作

' Inserts a row to the table from a range object.
Private Function InsertTableRowFromRange(table As ListObject, source As Range)

  Dim newRow As ListRow

  Set newRow = table.ListRows.Add(AlwaysInsert:=True)
  newRow.Range(1, 1).Resize(source.Rows.Count, source.Columns.Count) _
        .Value = source.Value

End Function

然后可以在其他表中的行上循环，并插入适合账单的范围

' Inserts toggled rows from the source table to the target table.
Private Function InsertToggledRows(source As ListObject, target As ListObject)

  Dim row As ListRow

  For Each row In source.ListRows
    If row.Range(1, 1).Value = "yes" Then
      InsertTableRowFromRange target, row.Range
    End If
  Next

End Function

复制品呢？ 使用VBA处理重复项的方法有很多，您可能还需要考虑一些不同的场景。考虑下面的情况，例如：

索引为8的项在两个不同的表中设置为

yes

，并且在每个表中具有不同的名称。应该使用哪张表？如果一个表中的项目设置为

yes

，而另一个表中的项目设置为

no

，该怎么办

---

对于上面屏幕截图中的结果，我将主表中的索引添加到

数组中

，并使用函数from将潜在的新索引与数组中的索引进行比较

InsertToggledRows

也需要进行一些更改，因为它现在还必须更新

索引

数组。在下面的示例中，我采用的路径涉及一些笨拙的返回值，并且不是唯一的方法

示例设置

---

如果使用表格，您是否查找过表格符号？试试宏录制器，看看如何与之交互如何？太好了，谢谢！它完全符合我的意图。只是一个简单的问题，如果表位于不同的工作表上，那么需要更改什么？唯一需要更改的是变量定义本身。在本例中，所有三个表都是在

With ws

块中设置的-您也可以为不同的工作表设置每个表。谢谢，这非常有效。我遇到的一个小问题是更新公式。每个表（复制到和复制自）中的最后一列是计算值。添加新行后，它仅作为文本/值，如何使其保留公式，或在复制后自动填充现有公式？请避免在注释中提出与原始问题不直接相关的问题。如果你找不到你想要的东西，你可以试着四处挖掘或者问一个新问题。话虽如此，原因是代码复制的是

值

，而不是

公式

。在

InsertTableRowFromRange

函数中，

newRow.Value

设置为

source.Value

。如果您希望复制公式，请用

.Formula

替换这两个公式。

Option Explicit

' Inserts toggled rows with unique identifiers from other tables to the master.
Public Sub InsertTablesToMasterTable()

  Application.ScreenUpdating = False

  Dim ws As Worksheet
  Dim masterTable As ListObject
  Dim firstTable As ListObject
  Dim secondTable As ListObject
  Dim indexes() As Variant

  Set ws = ThisWorkbook.Worksheets(1)
  ' Set your table objects to variables
  With ws
    Set masterTable = .ListObjects("Master")
    Set firstTable = .ListObjects("Table1")
    Set secondTable = .ListObjects("Table2")
  End With

  ' Get the indexes from the existing table
  indexes = GetInitialIndexes(masterTable)

  ' Insert the rows & update the indexes array
  indexes = InsertUniqueToggledRows(firstTable, masterTable, indexes)
  indexes = InsertUniqueToggledRows(secondTable, masterTable, indexes)

  Application.ScreenUpdating = True

End Sub

' Returns an array of the initial indexes found in the table.
Private Function GetInitialIndexes(table As ListObject) As Variant

  Dim arr() As Variant
  ReDim arr(0 To table.ListRows.Count)
  Dim row As ListRow
  Dim i As Integer

  i = 0
  For Each row In table.ListRows
    arr(i) = row.Range(1, 2).Value
    i = i + 1
  Next

  GetInitialIndexes = arr

End Function

' Inserts toggled rows from the source table to the target table and returns
' an array which has the new indexes appended to the existing array.
Private Function InsertUniqueToggledRows( _
                                          source As ListObject, _
                                          target As ListObject, _
                                          indexes As Variant _
                                        ) As Variant

  Dim arr() As Variant
  Dim row As ListRow

  arr = indexes

  For Each row In source.ListRows
    If row.Range(1, 1).Value = "yes" And _
    Not IsInArray(row.Range(1, 2).Value, indexes) Then
      InsertTableRowFromRange target, row.Range

      ' Push the new index to the array
      ReDim Preserve arr(0 To UBound(arr) + 1) As Variant
      arr(UBound(arr)) = row.Range(1, 2).Value
    End If
  Next

  InsertUniqueToggledRows = arr

End Function

' Inserts a row to the table from a range object.
Private Function InsertTableRowFromRange(table As ListObject, source As Range)

  Dim newRow As ListRow

  Set newRow = table.ListRows.Add(AlwaysInsert:=True)
  newRow.Range(1, 1).Resize(source.Rows.Count, source.Columns.Count) _
        .Value = source.Value

End Function

' Returns true if the string is found in the array.
Private Function IsInArray(stringToFind As String, arr As Variant) As Boolean
  IsInArray = (UBound(Filter(arr, stringToFind)) > -1)
End Function