Option Explicit

Sub aaa()
    Dim r As Range
    Set r = Selection
    Dim arr As Variant
    arr = r
    Dim brr As Variant
    brr = Range(Cells(2, r.Column), Cells(r.Row - 1, r.Column))
    Dim crr As Variant
    crr = Range(Cells(r.Row + r.Rows.Count, r.Column), Cells(Rows.Count, r.Column).End(xlUp))
    
    With Workbooks.Add(1)
        With .Sheets(1)
            With .Cells(1, 1).Resize(UBound(arr, 1), 1)
                .Value = arr
            End With
            With .Cells(1, 2).Resize(UBound(brr, 1), 1)
                .Value = brr
            End With
            With .Cells(1 + UBound(brr, 1), 2).Resize(UBound(crr, 1), 1)
                .Value = crr
            End With
            
            Cells.FormatConditions.Delete
            ActiveSheet.UsedRange.Select
            Selection.FormatConditions.AddUniqueValues
            Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
            Selection.FormatConditions(1).DupeUnique = xlUnique
            With Selection.FormatConditions(1).Font
                .Color = -16383844
                .TintAndShade = 0
            End With
            With Selection.FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 13551615
                .TintAndShade = 0
            End With
            Selection.FormatConditions(1).StopIfTrue = False
        End With
    End With
End Sub