تفضل
Sub Copying_yellow_cells()
Dim i As Long, j As Long
For i = 5 To Range("f" & Rows.Count).End(xlUp).Row
For j = 1 To Columns("H").Column
If Cells(i, j).DisplayFormat.Interior.Color = vbYellow Then
Cells(i, "H").Value = Cells(i, j).Value
Exit For
End If
Next
Next
End Sub
نسخ الخلايا الملونة في العمود B.xlsm