Copying Cell Value On The Same Row Based On Another Column Cell Color-CodePudding

I am trying to be able to search through a list in Column W and any cell in Column W that is highlighted Yellow to Copy Cell from Column B from the same row as colored cell in Column W.

This is what I have so far:

Sub CopyData()

Dim YellowField As Range
Dim YellowCell As Range
Dim Amortized As Worksheet
Dim Rollforward As Worksheet

Set Amortized = Worksheets("AMORTIZED")
Set Rollforward = Worksheets("Rollforward")
Set YellowField = Amortized.Range("W4", Amortized.Range("W4").End(xlDown))

For i = 4 To YellowField.UsedRange.Rows.Count
For Each YellowCell In YellowField
    If YellowCell.Interior.Color = vbYellow Then
        x = Amortized.Cells(i, ColumnD).Value
        x.Copy Destination:= _
        Rollforward.Range("B30").Offset(Rollforward.Rows.Count - 1, 0).End(xlUp).Offset(1, 0)
        
    
                Exit For
            End If
        Next YellowCell
    Exit For
Next i

End Sub

Currently when I run I get Error 439 on this line.

 x = Amortized.Cells(i, ColumnD).Value

I was using .color and switched to .value because I feel it would assume if column D was colored I could be wrong though. Plus I feel I am still missing the loop here where the list would continue to be scanned for more colored cells in Column W

CodePudding user response：

ColumnD is being read as a Variant it does not mean Column D Use 4 instead.

The inner loop is not needed and will give you a lot of false positive copies.

And to copy X you need to make it a Range and Set it. But in this case just use the cell itself.

Sub CopyData()

Dim LstRow As Long
Dim Amortized As Worksheet
Dim Rollforward As Worksheet

Set Amortized = Worksheets("AMORTIZED")
Set Rollforward = Worksheets("Rollforward")
LstRow = Amortized.Cells(Amortized.Rows.Count,23).End(xlUp).Row

For i = 4 To lstrow
    If Amortized.Cells(i,23).Interior.Color = vbYellow Then
        Amortized.Cells(i, 4).Copy Destination:= _
            Rollforward.Cells(Rollforward.Rows.Count,2).End(xlUp).Offset(1,0)
    End If
Next i

End Sub