Transfer data to other sheets VBA

[jalolbek85]

Hi All,

I want to transfer all the "a" products to Sheet a, "b" products to Sheet b and "c" products to Sheet c
considering the id code.
If the id is already exist in a, b and c Sheets, then those products won't be transferred in order to avoid having duplicate data.

I have attached the file.
Thanks in advance

[NewYears1978]

<redacted> Will update post.

[jindon]

For workbook uploaded.

Please Login or Register  to view this content.

Edit

[bebo021999]

May be:

Option Explicit 
Sub tranfer() 
Dim lr&, i&, j&, k&, rng, rng2, id, arr() 
Dim dic As Object, ws As Worksheet 
Set dic = CreateObject("Scripting.Dictionary") 
With Sheets("Data") 
    lr = .Cells(Rows.Count, "B").End(xlUp).Row 
    rng = .Range("B6:AA" & lr).Value 
End With 
For Each ws In Sheets 
    ReDim arr(1 To 100000, 1 To UBound(rng, 2)) 
    dic.RemoveAll 
    With ws 
        If .Name <> "Data" Then 
            lr = .Cells(Rows.Count, "B").End(xlUp).Row 
            If lr > 5 Then 
                rng2 = .Range("B6:AA" & lr).Value 
                For i = 1 To UBound(rng2) 
                    id = rng2(i, 1) & "|" & rng2(i, 4) 
                    If Not dic.exists(id) Then dic.Add id, "" 
                    For j = 1 To UBound(rng2, 2) 
                        arr(i, j) = rng2(i, j) 
                    Next 
                Next 
            k = UBound(rng2) 
            End If 
            For i = 1 To UBound(rng) 
                id = rng(i, 1) & "|" & rng(i, 4) 
                If Not dic.exists(id) And rng(i, 4) = .Name Then 
                    k = k + 1 
                    For j = 1 To UBound(rng, 2) 
                        arr(k, j) = rng(i, j) 
                    Next 
                End If 
            Next 
            .Range("B6:AA100000").ClearContents 
            .Cells(lr, "B").Resize(k, UBound(rng2, 2)).Value = arr 
        End If 
    End With 
Next 
End Sub  

[jalolbek85]

Thank you jindon, it's working supper, can we set the range like, from B to AA columns only please. The data shouldn't be transferred even if there is data after column AA

[jalolbek85]

thanks bebo021999, tried the code, but it's keep deleting the date in other a, b, and c sheets, when I run the code more than 1 time.

[jindon]

Try change

Please Login or Register  to view this content.

to

Please Login or Register  to view this content.

[jalolbek85]

Thanks a lot jindon, working superb..