Aynı olanları bir kere kopyalasın ...

aliakgul

Altın Üye
Katılım
9 Mayıs 2005
Mesajlar
402
Excel Vers. ve Dili
Ofis 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
03-08-2025
Selam arkadaşlar,
Butona tıklayınca A sütunundaki verilerin B sütununa kopyalanmasını istiyorum.Ancak değeri aynı olan hücrelerden sadece bir tane kopyalayacak, yani tekrar eden hücrelerden sadece biri alınacak sonrada yukardan aşağı alfabetik sıralayacak... Teşekkür ederim.
 

Ali

Uzman
Katılım
21 Temmuz 2005
Mesajlar
7,897
Excel Vers. ve Dili
İş:Excel 2016-Türkçe
Ekteki dosya işinizi görür sanırım. İyi çalışmalar
 

aliakgul

Altın Üye
Katılım
9 Mayıs 2005
Mesajlar
402
Excel Vers. ve Dili
Ofis 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
03-08-2025
Çalışman için teşekkür ederim ama sorum tam anlaşılmamış galiba. Ben aynı sütundaki verileri kopyalarken, aynı değerlere sahip olan hücrelerin süzülmesini yani birden fazla değerlerdefn sadece bir tane alınarak kopyalanmasını istiyorum. Örneğin; sütunumda 1,2,3,3,3,4,4,5,5,5,5,6,6 değerlei varsa bana 1,2,3,4,5,6 şeklinde kopyalasın... Teşekkür ederim
 

mehmett

Altın Üye
Katılım
18 Mayıs 2005
Mesajlar
2,571
Excel Vers. ve Dili
Excel 2010 Türkçe
Sn aliakgul,

Bu işlem için menülerden aşağıdaki komutları sırayla verin,

Veri, Filtre uygula, Gelişmiş filtre, Başka bir yere kopyala, Yalnızca benzersiz kayıtlar.

"Hedef" yazan yere gelince hangi sütuna kopyalanmasını istiyorsanız o sütunu seçin.

Bu komutları vermeye başlamadan önce Makro kaydet komutunu çalıştırırsanız yaptığınız işlem Makro olarak kaydedilecektir.

Örnek dosya ekte.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,247
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Aşağıdaki kod A sütunundaki sırasız olan verileri süzerek B sütununda listeler ve alfabetik olarak sıralar.

Kod:
Sub SÜZ_SIRALA()
    Range("B2:B65536").ClearContents
    Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns("B:B"), Unique:=True
    Range("B2:B65536").Sort Key1:=Range("B2"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("A1").Select
End Sub
 

aliakgul

Altın Üye
Katılım
9 Mayıs 2005
Mesajlar
402
Excel Vers. ve Dili
Ofis 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
03-08-2025
Arkadaşlar, Emek ve ilginizden dolayı hepinize teşekkür ederim. Ancak bu anlattığınız yolu ben zaten uyguladım.Sıkıntıyı da zaten bu aşamada yaşıyorum. Bu yolla yapınca, farketmişsinizdir ki, ilk hücrenin değeri sütuna başlık olarak alınıyor ve her zaman için ilk hücredeki değer iki kere alınıyor. Bunu aşamadım yani...Kolay gelsin
 

zafer

Super Moderator
Yönetici
Katılım
8 Mart 2005
Mesajlar
3,288
Excel Vers. ve Dili
OFFICE 2003 TÜRKÇE
OFFICE 2010 TÜRKÇE
Merhaba

Aşağıdaki kodları denermisiniz.

Sub listele2()
For b = 2 To Cells(65536, 2).End(xlUp).Row
If WorksheetFunction.CountIf(Range("b2:b" & b), Cells(b, 2)) = 1 Then
c = c + 1
Sheets("sayfa1").Cells(c , 4) = Cells(b, 2).Value

End If
Next
End sub

Kodlar Sayın Leventm'e aittir.
 

aliakgul

Altın Üye
Katılım
9 Mayıs 2005
Mesajlar
402
Excel Vers. ve Dili
Ofis 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
03-08-2025
teşekkür ederim ancak ben bu kodları kendi çalışmama uygularken başaramadım. Yani neyin ne olduğunu tam anlayamadım.örneğin ;
"liste!E:E" aralığını "ayarlar!B:B" aralığına süzdürecek olsam bu kodları nasıl uyarlamam gerekiyor? (macroyu çalıştıracak olan buton "liste" adlı sayfada yer alıyor)
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Aşağıdaki gibi deneyin.

[vb:1:8c62f92858]Sub listele2()
For b = 2 To sheets("liste").cells(65536,"e").End(xlUp).Row
If WorksheetFunction.CountIf(sheets("liste").Range("e1:e" & b), sheets("liste").Cells(b, "e")) = 1 Then
c = c + 1
Sheets("ayarlar").Cells(c , "b") = sheets("liste").Cells(b, "e").Value
End If
Next
End sub
[/vb:1:8c62f92858]
 

aliakgul

Altın Üye
Katılım
9 Mayıs 2005
Mesajlar
402
Excel Vers. ve Dili
Ofis 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
03-08-2025
Arkadaşlar,
Sayenizde sorun halloldu. Hepinize çok teşekkür ederim..... :hey: :hey: :hey:
 
Üst