Copy specific cells from one range to different locations in another range

Question

I need to copy the value from a cell on one table to a cell on another table. The cell row is defined by a variable, the column is not. I believe I only need help with the bottom line of the following code. Once solved, I will replicate the solution numerous times to copy several different cells to new locations.

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

I keep receiving an error saying Type mismatch.

Answer 1

Here's one approach:

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