无法将行粘贴到表格

Question

对于表“TableQueue”的“Transition”列中不为空的每个单元格，我想：
1）从表“TableQueue”复制包含该单元格的整个表行， 2）将该行粘贴到表格“TableNPD”的底部， 3）从表“TableQueue”中删除行

除了复制/粘贴/删除之外，我已经完成了所有工作。在下面的代码中查看我的注释，看看我的问题从哪里开始。我是 vba 的新手，虽然我可以找到大量关于复制和粘贴到表格底部的信息，但它们彼此之间略有不同，并且与我已经设置代码的上半部分的方式不同。我需要解决方案来对我已经设置的内容进行尽可能少的更改；...我将无法理解任何大不相同的内容。

Sub Transition_from_Queue2()

Dim QueueSheet As Worksheet
Set QueueSheet = ThisWorkbook.Sheets("Project Queue")   

Dim QueueTable As ListObject
Set QueueTable = QueueSheet.ListObjects("TableQueue")

Dim TransColumn As Range
Set TransColumn = QueueSheet.Range("TableQueue[Transition]")

Dim TransCell As Range
Dim TransQty As Double

    For Each TransCell In TransColumn
        If Not IsEmpty(TransCell.Value) Then
            TransQty = TransQty + 1
        End If
    Next TransCell

Dim TransAnswer As Integer

If TransQty = 0 Then
    MsgBox "No projects on this tab are marked for transition."
        Else
        If TransQty > 0 Then
            TransAnswer = MsgBox(TransQty & " Project(s) will be transitioned from this tab." & vbNewLine & "Would you like to continue?", vbYesNo + vbExclamation, "ATTEMPT - Project Transition")
                If TransAnswer = vbYes Then

'Add new row to NPD table
                    For Each TransCell In TransColumn
                        If InStr(1, TransCell.Value, "NPD") > 0 Then
                            Dim Trans_new_NPD_row As ListRow
                            Set Trans_new_NPD_row =     ThisWorkbook.Sheets("NPD").ListObjects("TableNPD").ListRows.Add

'我得到了上面的一切工作。我的问题在于这里的所有内容。

                            'Copy Queue, paste to NPD, and Delete from Queue
                            Dim TransQueueRow As Range
                            Set TransQueueRow = TransCell.Rows
                            TransQueueRow.Copy
                            Dim LastPasteRow As Long
                            Dim PasteCol As Integer
                                With Worksheets("NPD")
                                    PasteCol = .Range("TableNPD").Cells(1).Column
                                    LastPasteRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
                                End With
                            ThisWorkbook.Worksheets("NPD").Cells(LastPasteRow, PasteCol).PasteSpecial xlPasteValues

Answer 1

Trans_new_NPD_row.Range 是您刚刚添加的新行的范围，因此您应该可以使用类似

Set Trans_new_NPD_row = ThisWorkbook.Sheets("NPD").ListObjects("TableNPD").ListRows.Add 

Trans_new_NPD_row.Range.Value = _
         Application.Intersect(TransCell.EntireRow, QueueTable.DataBodyRange).Value

编辑：这是一个使用 listobject/table 方法将行从一个表移动到另一个表的工作示例

Sub tester()

    Dim tblQueue As ListObject, tblNPD As ListObject, c As Range, rwNew As ListRow
    Dim rngCol As Range, n As Long

    Set tblQueue = Sheet1.ListObjects("Queue")  '<< source table
    Set tblNPD = Sheet2.ListObjects("TableNPD") '<< destination table

    Set rngCol = tblQueue.ListColumns("Col3").DataBodyRange

    'loop from the bottom to the top of the source table
    For n = tblQueue.ListRows.Count To 1 Step -1
        'move this row?
        If rngCol.Cells(n) = "OK" Then
            Set rwNew = tblNPD.ListRows.Add
            rwNew.Range.Value = tblQueue.ListRows(n).Range.Value
            tblQueue.ListRows(n).Delete
        End If
    Next n

End Sub

源表（目的表格式相同）：