Sub TestA_v3()
    Dim Cll As Range, c As Range
    Dim n As Long
    Application.ScreenUpdating = False
    With ActiveSheet
        For Each Cll In .Range("AN:AN").SpecialCells(xlCellTypeConstants, 3)
            If Cll.Interior.ColorIndex = 3 Then
                Set c = .Columns(46).Find(Cll)
                If c Is Nothing Then _
                    Cll.Resize(, 3).Copy .Cells(Rows.Count, 46).End(xlUp)(2)
            End If
        Next Cll
    End With
    Application.ScreenUpdating = True
End Sub