```
Sub duplik()
Dim a, b As Range, c(), n As Long, m As Integer
Dim x, j As Integer, p As Long
a = ActiveSheet.UsedRange
n = UBound(a, 1): m = UBound(a, 2)
ReDim c(1 To n - 1, 1 To m)
Set b = ActiveSheet.UsedRange.Resize(n - 1).Offset(1)
With CreateObject("Scripting.Dictionary")
For i = 1 To n - 1
x = Empty
b.Rows(i).Sort b(i, 2), Orientation:=xlLeftToRight
For j = 1 To m: x = x & Chr(30) & b(i, j): Next j
If Not .exists(x) Then
.Add x, Empty
p = p + 1
For j = 1 To m: c(p, j) = a(i + 1, j): Next j
End If
Next i
End With
b.ClearContents
b(1, 1).Resize(p, m) = c
End Sub
```