Aynı olmayanların silinmesi

[maxinus]

Merhaba,

Benim excel sayfamda iki tane code kısımlı alan var.Ben A hücresinde olan kod eğer E hücresinin herhangi bir sütununda kayıtlı ise ben o E hücresinden başlayan Code,name,Fiili stok,Gerçek stok,Özel kod ve grup kodu altın da yazan bilgilerin sayfa2 'ye taşınmasını istiyorum.Yardımlarınız için teşekkür ederim.

 

[Ömer]

Merhaba,

Option Explicit
Sub OlaniAktar()
Dim S1, S2 As Worksheet
Dim i, sat As Long
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
Application.ScreenUpdating = False
S1.Select
S2.Range("A2:F65536").ClearContents
sat = 1
    For i = 2 To [E65536].End(3).Row
        If WorksheetFunction.CountIf(Range("A2:A" & i), Cells(i, "E").Value) > 0 Then
            sat = sat + 1
            S2.Range("A" & sat & ":F" & sat).Value = Range("E" & i & ":J" & i).Value
        End If
    Next i
Set S1 = Nothing
Set S2 = Nothing
Application.ScreenUpdating = True
MsgBox "Aktarım Tamamlanmıştır.", vbInformation, "[URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
End Sub

Denermisiniz.

.