将特定单元格从一个范围复制到另一范围的不同位置

时间:2019-07-12 20:00:38

标签: vba copy paste listobject

我需要将值从一个表上的单元格复制到另一张表上的单元格。单元格行是由变量定义的,列则不是。我相信我只需要帮助以下代码。解决后,我将多次复制该解决方案,以将几个不同的单元复制到新位置。

Sub Transition_Queue_to _NPD()
    Dim QueueSheet As Worksheet
    Set QueueSheet = ThisWorkbook.Worksheets("Project Queue")

    Dim TableQueue As ListObject
    Set TableQueue = 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


If TransQty > 0 Then
    Dim Trans_Queue_Row As Range
    Dim i As Integer

With TransColumn
    For i = 1 To .Count
        If InStr(1, .Rows(i).Value, "NPD") > 0 Then
            Set Trans_Queue_Row = TableQueue.DataBodyRange.Rows(i)
        End If

            Dim NPDSheet As Worksheet
            Set NPDSheet = ThisWorkbook.Worksheets("NPD")

            Dim TableNPD As ListObject
            Set TableNPD = NPDSheet.ListObjects("TableNPD")

            Dim Trans_NPD_Row As ListRow
            Set Trans_NPD_Row = TableNPD.ListRows.Add
'Here is where I need help.  I need to copy individual cells from Trans_Queue_Row to Trans_NPD_Row.  I have tried copying the cell in Column 2 to the cell in Column 1 via the following with no success.

            Cells(Trans_Queue_Row, 2).Value = Cells(Trans_NPD_Row, 1).Value

    Next i
End With
End If
End Sub

我一直收到错误消息Type mismatch

1 个答案:

答案 0 :(得分:2)

这是一种方法:

Sub Transition_Queue_to_NPD()

    Dim TableQueue As ListObject, TableNPD As ListObject, i As Long
    Dim TransColumn As Range, Trans_Queue_Row As Range, Trans_NPD_Row As Range

    Set TableQueue = ThisWorkbook.Worksheets("Project Queue").ListObjects("TableQueue")
    Set TableNPD = ThisWorkbook.Worksheets("NPD").ListObjects("TableNPD")

    Set TransColumn = TableQueue.ListColumns("Transition").DataBodyRange

    For i = 1 To TransColumn.Cells.Count
        If InStr(1, TransColumn.Cells(i).Value, "NPD") > 0 Then

            'get the source and destination row ranges
            Set Trans_Queue_Row = TableQueue.DataBodyRange.Rows(i)
            Set Trans_NPD_Row = TableNPD.ListRows.Add.Range

            Trans_NPD_Row.Cells(2).Value = Trans_Queue_Row.Cells(1).Value
            Trans_NPD_Row.Cells(3).Value = Trans_Queue_Row.Cells(4).Value
            'etc etc

        End If
    Next i

End Sub
相关问题