Проблема вставки строки в таблицу

Question

Для каждой ячейки, которая не является пустой в столбце «Переход» таблицы «TableQueue», я хочу:
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

Исходная таблица (пункт назначения имеет тот же формат):