Teke düşür aktar

[wirtue]

Arkadaşlar merhaba,

Aldığım raporda aynı barcod ve firma ismilerinden fazlasıyla çıkmakta bunları diğer sayfaya teke düşürüp nasıl aktarabilirim,

 

[Orion1]

Ekli dosyayı inceleyiniz.

Sub teke_dusur()
Dim i As Long, sat As Long
sat = 2
Sheets("_irs_detay2").Select
Application.ScreenUpdating = False
Sheets("teke düşür").Range("A2:A65536").ClearContents
For i = 3 To Cells(65536, "E").End(xlUp).Row
    If WorksheetFunction.CountIf(Range("E3:E" & i), Cells(i, "E").Value) = 1 Then
        Sheets("teke düşür").Cells(sat, "A").Value = Cells(i, "E").Value
        sat = sat + 1
    End If
Next i
Application.ScreenUpdating = True
MsgBox "Teke Düşürüldü" & vbLf & vbLf & "evrengizlen@hotmail.com", _
vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[wirtue]

Sn Evren Gizlen Tşk ler,

 

[Orion1]

Sn Evren Gizlen Tşk ler,

Rica ederim.