help changing repeating code into array of somekind also copy highlighted rows to new shee

Another approach?

Sub baby_kay_2003()
Dim fCell As Range

For Each fCell In ActiveSheet.UsedRange
    Select Case Left(fCell, 8)
        Case Is = "DVOK8467", "DVOK8443", "DVOK8720", "5DVIA8797", "DVIA8809"
            fCell.EntireRow.Interior.ColorIndex = 6
    End Select
Next fCell
        
End Sub