Sub UniqueItems()
    Dim avarItems As Variant
    Dim avarUniqueItems() As Variant
    Dim intI As Integer
    Dim intJ As Integer
    Dim intK As Integer
    Dim blnFlag As Boolean
    
    avarItems = Worksheets("Лист1").Range("A2:C7")
    
    ReDim Preserve avarUniqueItems( 1  To  6 )
    
    For intI = LBound(avarItems,  1 ) To UBound(avarItems,  1 )
        avarUniqueItems(intI) = avarItems(intI,  1 )
    Next intI
    
    intK =  2 

    Do While intK <=  3 
        For intI = LBound(avarItems,  1 ) To UBound(avarItems,  1 )
            blnFlag = True
            For intJ = LBound(avarUniqueItems) To _
              UBound(avarUniqueItems)
                If avarItems(intI, intK) = avarUniqueItems(intJ) Then
                    blnFlag = False
                    Exit For
                End If
            Next intJ
            If blnFlag Then
                ReDim Preserve avarUniqueItems( 1  To _
                  UBound(avarUniqueItems) +  1 )
                avarUniqueItems(UBound(avarUniqueItems)) = _
                  avarItems(intI, intK)
            End If
        Next intI
        intK = intK +  1 
    Loop

    For intI = LBound(avarUniqueItems) To UBound(avarUniqueItems)
        Worksheets("Лист1").Cells(intI +  1 ,  4 ) = avarUniqueItems(intI)
    Next intI
End Sub