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

[1Al2Ver]

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.

 

[Muzaffer Ali]

Merhaba.
Bir modüle kopyalayıp çalıştırın.

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]

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.

 

[Muzaffer Ali]

Sadece Üretim ile başlayan sayfalarda arama yapar.

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]

Sayın Muzaffer Ali, tekrar merhaba,

Yeni kod sorunsuz çalışıyor,

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

Saygılarımla.

 

[CenTay]

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

 

[CenTay]

Güncel...

 

[Muzaffer Ali]

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.

.Cells(SatirSay, "B") = syf.Cells(Bak, "B")

Eğer sorun farklıysa lütfen örnek dosya ekleyiniz.

 

[CenTay]

Değerli hocam çözüm doğrudur sağolasın iyiki varsınız.