tekrar edenleri 2.sheete atma

[uslu45]

selam,
benim tuttuğum bir dosyam var, bu dosyada "a" sütunundaki fiş numaralarından aynı olanları görmek istiyorum. gerçek dosyam 10000 satıra yakın buraya ufak bi örneğini koydum. yardımcı olursanız sevinirim. tam olarak istediğim şu;
a sütununda dosyanın herhangi bir satırında (a sütununda olmak şartıyla) tekrar eden bir fiş no varsa o fiş nolarının bulunduğu sağa doğru bütün satırı ile birlikte 2. sheet'e atsın, yani 1.sheet'den kessin istiyorum. sonra ben aynı olan satırlar ile ilgili işlem yapıp onları teke düşürüp tekrar 1.sheet'e atacağım , böylece mükerrer kayıt kalmayacak.
yardımcı olursanız çok sevinirim
kolay gelsin herkese...

 

[dEdE]

Merhaba,

Dosyanız ilişiktedir.
Kolay gelsin.

 

[uslu45]

dEdE öncelikle teşekkürler eline bilgine sağlık,
ancak o sarı ile işaretlediğin satırların hepsini 2. sheete atmamız mümkün mü. ben daha sonra 2.sheet de o mükerrerlerin 1 er tanesini eleyip tekrar 1. sheete yapıştırıcam.
kolay gelsin

 

[uslu45]

dEdE öncelikle teşekkürler eline bilgine sağlık,
ancak o sarı ile işaretlediğin satırların hepsini 2. sheete atmamız mümkün mü. ben daha sonra 2.sheet de o mükerrerlerin 1 er tanesini eleyip tekrar 1. sheete yapıştırıcam.
kolay gelsin

Merhaba,

Dosyanız ilişiktedir.
Kolay gelsin.

 

[dEdE]

Merhaba,
Dosyanızdaki kodları aşağıdakilerle değiştirin.

Sub Aktar()
Set s1 = Sheets(1)
Set s2 = Sheets(2)

s2.Cells.ClearContents
s1.Select
Sat = [a65536].End(3).Row

For i = 2 To Sat
If WorksheetFunction.CountIf(Range(Cells(2, "A"), Cells(Sat, "A")), Cells(i, "A")) > 1 Then
    ss = s2.[a65536].End(3).Row
    ss = IIf(s2.Cells(1, 1) = "", 1, ss + 1)
    s2.Rows(ss).Value = s1.Rows(i).Value
    Rows(i).Interior.ColorIndex = 6
End If
Next i

For k = Sat To 2 Step -1
If Rows(k).Interior.ColorIndex = 6 Then
    Rows(k).Delete
End If
Next k
    s2.Cells.EntireColumn.AutoFit
    MsgBox "Mükerrer Kayıtları Aktarma İşlemi Tamamlandı. ", vbInformation, "dEdE Kolaylıklar Diler."
End Sub

 

[uslu45]

eline sağlık hocam saol ne kadar makbule geçti bilemezsin.

 

[dEdE]

eline sağlık hocam saol ne kadar makbule geçti bilemezsin.

Güle güle kullanın.

 

[bornovalı1]

merhaba;

Sub Aktar()
Set s1 = Sheets(1)
Set s2 = Sheets(2)

s2.Cells.ClearContents
s1.Select
Sat = [a65536].End(3).Row

For i = 2 To Sat
If WorksheetFunction.CountIf(Range(Cells(2, "A"), Cells(Sat, "A")), Cells(i, "A")) > 1 Then
ss = s2.[a65536].End(3).Row
ss = IIf(s2.Cells(1, 1) = "", 1, ss + 1)
s2.Rows(ss).Value = s1.Rows(i).Value
Rows(i).Interior.ColorIndex = 6
End If
Next i

For k = Sat To 2 Step -1
If Rows(k).Interior.ColorIndex = 6 Then
Rows(k).Delete
End If
Next k
s2.Cells.EntireColumn.AutoFit
MsgBox "Mükerrer Kayıtları Aktarma İşlemi Tamamlandı. ", vbInformation, "dEdE Kolaylıklar Diler."
End Sub

Bu kodu kullanıyorum ama mükerrer olan kayıtların hepsini almak istemiyorum birer tanesinin ilk sayfada kalmasını istiyorum.

Mesela 2 tane varsa birisini alsın 5 tane varsa 4 tanesini alsın şeklinde bu konuda yardımcı olabilirmisiniz.

 

[Erdem Akdemir]

Merhaba,

Bununla ilgili yeni konu açar mısınız? Örnek dosya'da eklemeyi unutmayın.

Tek olan kayıtlarla ilgili işlem yapılacak mı?