How to fully qualify a range to copy from Sheet1 and paste to Sheet2?

Question

I want to run a script to find cells highlighted yellow, on Sheet1 and if yellow, copy/paste to Sheet2. The code below seems like it should work, but it's failing on this line.

rc.Copy rd

Basically, I would like to concatenate values in Columns 2, 3, and 17, on Sheet1, and copy/paste everything to Sheet2. I'm guessing that I'm missing some kind of Worksheet reference, but I don't know for sure, and so far nothing has worked for me. But...I think this is pretty close!! Any help is appreciated!

Sub ColorCopier()
Dim i As Long
Dim j As Long
Dim sht As Worksheet
Dim LastRow As Long
Set sht = ThisWorkbook.Worksheets("Version Control")
LRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1

    'k = 1
    Set rc = Sheets("Cobrand Tasklist").UsedRange
    For i = 1 To rc.Rows.Count
        For j = 1 To rc.Columns.Count

            If Cells(i, j).Interior.ColorIndex = 6 Then

                    If j = 2 Then
                    Set rc = Cells(i, j)
                    Set rd = Sheets("Version Control").Cells(LRow, 4)
                        rc = "Task #" & rc
                        rc.Copy rd
                    End If

                    If j = 3 Then
                    Set rc = Cells(i, j)
                    Set rd = Sheets("Version Control").Cells(LRow, 4)
                        rc = "Task Title " & rc
                        rc.Copy rd
                    End If

                    If j = 17 Then
                    Set rc = Cells(i, j)
                    Set rd = Sheets("Version Control").Cells(LRow, 4)
                        rc = "Task Description " & rc
                        rc.Copy rd
                    End If

                LRow = LRow + 1
            End If
        Next
    Next
End Sub

Answer 1

You really could condense the code down to stop repeating the same code. But , I left it the way you have done it to illustrate a different way of doing what I think you are trying to do.

Dim i As Long
Dim j As Long
Dim sht As Worksheet
Dim LastRow As Long
Dim rng As Range
Dim str As String
Dim rng As Range

'
Set sht = ThisWorkbook.Worksheets("Version Control")
LRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1

    'k = 1
    Set rc = Sheets("Cobrand Tasklist").UsedRange
    For i = 1 To rc.Rows.Count
        For j = 1 To rc.Columns.Count

            If Cells(i, j).Interior.ColorIndex = 6 Then

                    If j = 2 Then
                    Cells(i, j).Value = "Task #" & Cells(i, j).Value
                    If Not rng Is Nothing Then Set rng = Union(rng, Cells(i, j)) Else Set rng = Cells(i, j)
                    End If

                    If j = 3 Then
                    Cells(i, j).Value = "Task Title " & Cells(i, j).Value
                    If Not rng Is Nothing Then Set rng = Union(rng, Cells(i, j)) Else Set rng = Cells(i, j)
                    End If

                    If j = 17 Then
                    Cells(i, j).Value = "Task Description " & Cells(i, j).Value
                    If Not rng Is Nothing Then Set rng = Union(rng, Cells(i, j)) Else Set rng = Cells(i, j)
                    End If

                LRow = LRow + 1
            End If
        Next
    Next
    rng.Copy Sheets("Version Control").Cells(LRow, 4)

Doing the copy and paste on one line instead of every time inside the loop will speed up your code enormously.