Benzersiz Veri Al-Sırala, Diğer Sayfalardan

1Al2Ver

Altın Üye
Katılım
5 Kasım 2007
Mesajlar
4,708
Excel Vers. ve Dili
64 Bit TR - Microsoft Office 365 - Win11 Home
Merhaba,

Ek'li dosyada, "ÜRETİM_OCAK" sayfasına, ay adı içeren 11 sayfadan benzersiz veri almak istiyorum,

Düğme her tıklandığında, "ÜRETİM_OCAK" sayfasında olmayan, ancak diğer sayfalarda olan ad ve soyadlar "B4:B500" aralığına gelebilmeli,

Teşekkür ederim.
 

Ekli dosyalar

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,803
Excel Vers. ve Dili
2019 Türkçe
Merhaba.
Bir modüle kopyalayıp çalıştırın.
Kod:
Sub BenzersizVeriAl()
    Dim syf As Worksheet
    Dim syfDiger As Worksheet
    Dim Bul As Range
    Dim SatirSay As Long
    Dim Bak As Long
    For Each syf In ThisWorkbook.Worksheets
        For Bak = 4 To syf.Cells(Rows.Count, "B").End(xlUp).Row
            With ThisWorkbook.Worksheets("ÜRETİM_OCAK")
                Set Bul = .Range("B:B").Find(what:=syf.Cells(Bak, "B"), lookat:=xlWhole)
                If Bul Is Nothing Then
                    SatirSay = .Cells(Rows.Count, "B").End(xlUp).Row + 1
                    .Cells(SatirSay, "B") = syf.Cells(Bak, "B")
                    .Cells(SatirSay, "A") = SatirSay - 3
                End If
            End With
        Next
    Next
    MsgBox "İşlem tammalandı"
End Sub
 

1Al2Ver

Altın Üye
Katılım
5 Kasım 2007
Mesajlar
4,708
Excel Vers. ve Dili
64 Bit TR - Microsoft Office 365 - Win11 Home
Sayın Muzaffer Ali, merhaba,

Öncelikle ilginiz için teşekkür ederim,

Ancak, ben sekmelerde "ÜRETİM_..." yazan 11 aydan verileri almak istiyorum, kod bu haliyle tüm sayfalardaki "B4:B" aralığını getiriyor,

Mümkün ise kodu önünde "ÜRETİM_ " yazan 11 sayfa için ( ŞUBAT:ARALIK) düzenlyebilir misiniz ?

Teşekkür ederim.
 

Ekli dosyalar

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,803
Excel Vers. ve Dili
2019 Türkçe
Sadece Üretim ile başlayan sayfalarda arama yapar.

Kod:
Sub BenzersizVeriAl()
    Dim syf As Worksheet
    Dim syfDiger As Worksheet
    Dim Bul As Range
    Dim SatirSay As Long
    Dim Bak As Long
    For Each syf In ThisWorkbook.Worksheets
        If Left(syf.Name, 6) = "ÜRETİM" Then
            For Bak = 4 To syf.Cells(Rows.Count, "B").End(xlUp).Row
                With ThisWorkbook.Worksheets("ÜRETİM_OCAK")
                    Set Bul = .Range("B:B").Find(what:=syf.Cells(Bak, "B"), lookat:=xlWhole)
                    If Bul Is Nothing Then
                        SatirSay = .Cells(Rows.Count, "B").End(xlUp).Row + 1
                        .Cells(SatirSay, "B") = syf.Cells(Bak, "B")
                        .Cells(SatirSay, "A") = SatirSay - 3
                    End If
                End With
            Next
        End If
    Next
    MsgBox "İşlem tammalandı"
End Sub
 

1Al2Ver

Altın Üye
Katılım
5 Kasım 2007
Mesajlar
4,708
Excel Vers. ve Dili
64 Bit TR - Microsoft Office 365 - Win11 Home
Sayın Muzaffer Ali, tekrar merhaba,

Yeni kod sorunsuz çalışıyor,

Zahmetleriniz ve ilginiz için teşekkür ederim.

Saygılarımla.
 
Katılım
27 Haziran 2010
Mesajlar
394
Excel Vers. ve Dili
Türkçe 2010 Ofis
Hocam merhaba koddan bende faydalandım Koda C sütunlarını da dahil etmek istiyorum yardımcı olursanız memnun olurum teşekkürler hocam
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
5,803
Excel Vers. ve Dili
2019 Türkçe
Aşağıdaki kod satırı B sütunu için. C sütunu da aktarılsın istiyorsanız aynı satırdan ekleyip B leri C yapabilirsiniz.
Kod:
.Cells(SatirSay, "B") = syf.Cells(Bak, "B")
Eğer sorun farklıysa lütfen örnek dosya ekleyiniz.
 
Katılım
27 Haziran 2010
Mesajlar
394
Excel Vers. ve Dili
Türkçe 2010 Ofis
Değerli hocam çözüm doğrudur sağolasın iyiki varsınız.
 
Üst