无法将行粘贴到表 [英] Trouble pasting row to table

问题描述

对于表"TableQueue"的过渡"列中每个非空白的单元格，我想要:
1)从表格"TableQueue"中复制包含该单元格的整个表格行， 2)将该行粘贴到"TableNPD"表的底部， 3)从表"TableQueue"中删除行

For every cell that is not blank in column "Transition" of table "TableQueue", I want to:
1)Copy from table "TableQueue" the entire table row that contains that cell, 2)Paste that row to the bottom of table "TableNPD", 3)Delete the row from table "TableQueue"

除了复制/粘贴/删除之外，我已经拥有所有工作.请在下面的代码中间查看我的注释，以查看问题的出处.我是vba的新手，尽管我可以找到很多有关复制和粘贴到表底部的信息，但它们彼此之间略有不同，并且与我已经设置了代码上半部分的方式有所不同.我需要一种解决方案，以对已设置的内容进行尽可能少的更改； ...我将无法理解与众不同的任何内容.

I've gotten everything except the copy/paste/delete to work. See my note halfway down the code below to see where my problem begins. I am new to vba and, although I can find plenty of info on copying and pasting to the bottom of a table, its all slightly different from each other and different from how I've already set up the top half of my code. I need the solution to make as few changes as possible to what I've already set up;...I won't be able to understand anything largely different.

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

'我在这里可以进行所有操作.我的问题在这里无所不能.

'I GOT EVERYTHING ABOVE HERE TO WORK. MY PROBLEM IS WITH EVERYTHING BELOW HERE.

                            '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

推荐答案

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

Trans_new_NPD_row.Range is the range for the new row you just added, so you should be able to use something like

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方法将行从一个表移动到另一个表的工作示例

here's a working example of moving rows from one table to another, using the listobject/table methods

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

源表(目标具有相同的格式):

Source table (destination has the same format):

这篇关于无法将行粘贴到表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！