find and move the duplicate values in another sheet

maximbebi · February 19th, 2014, 04:48 AM

Hello, please help me with a code macro, is to move the duplicate values in sheet2,

I want to change that results from sheet 2 to be placed on columns A and B,
not as it is now spread all over the sheet 2

Code:

Sub ertert() 
    Dim x, y(), i&, j&, t(), bu As Boolean 
    x = Sheets("Foaie1").Range("A2").CurrentRegion.Value 
    Redim y(1 To UBound(x), 1 To UBound(x, 2)) 
    With CreateObject("Scripting.Dictionary") 
        .CompareMode = 1 
        For i = 1 To UBound(x) 
            For j = 1 To UBound(x, 2) 
                If Len(x(i, j)) Then 
                    If .Exists(x(i, j)) Then 
                        t = .Item(x(i, j)): bu = True 
                        y(t(0), t(1)) = x(i, j): y(i, j) = x(i, j) 
                        x(i, j) = "": x(t(0), t(1)) = "" 
                    Else 
                        .Item(x(i, j)) = Array(i, j) 
                    End If 
                End If 
            Next j 
        Next i 
    End With 
    Sheets("Foaie1").Range("A2").Resize(i - 1, j - 1).Value = x 
    If bu Then Sheets("Foaie2").Range("A2").Resize(i - 1, j - 1).Value = y() 
End Sub

Thank you