无法将行粘贴到 table

Question

对于 table "TableQueue" 的 "Transition" 列中每个非空白的单元格，我想：
1) 从 table "TableQueue" 复制包含该单元格的整个 table 行， 2) 将该行粘贴到 table "TableNPD" 的底部， 3)从table"TableQueue"

中删除行

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

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 方法

将行从一个 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

源table（目标格式相同）：

无法将行粘贴到 table

Trouble pasting row to table

excel

vba

paste

listobject