Birden fazla sayfadaki verileri süzüp başka sayfaya aktarmak

[Jeeday]

Sorum ektedir....

 

[Ömer]

Merhaba,

Module kopyalayıp çalıştırın.
Sayfa isimlerini belirttiğiniz için sadece belirttiğiniz sayfa isimlerinde arama yaptım, eğer kod çalışmadaki tüm sayfalarda çalışacaksa, yani sürekli yeni sayfa ekleyecekseniz sayfalara da döngü kurmakta fayda var.

Sub BenzersizListele()
        
    Dim i As Byte, syf As Worksheet, j As Long, a1, d As Object, deg, dizi()
    
    Set d = CreateObject("Scripting.Dictionary")
    dizi = Array("Sheet1", "Sheet2", "Sheet3")
        
    Application.ScreenUpdating = False
    Sheets("Sheet4").Select
    Range("A:A").ClearContents
    
    For i = 0 To UBound(dizi)
        Set syf = Sheets(dizi(i))
        For j = 1 To syf.Cells(Rows.Count, "A").End(xlUp).Row
            deg = syf.Cells(j, "A")
            If Not d.exists(deg) Then
                d.Add deg, Nothing
            End If
        Next j
    Next i
    
    a1 = d.keys
    Range("A1").Resize(UBound(a1) + 1, 1) = WorksheetFunction.Transpose(a1)

End Sub

.

 

[f_desat]

Sadece Sheet1 için Sheet4'e aktarma işlemi yaptım isimleri tek gösterecek şekilde....

 

[Excelmy]

1-2-3. sayfadaki verileri süzüp her ismi bir kere yazmak şartı ile buraya kopyalamasını istiyorum... sayfa adetleri çoğalabilir...

Sayın jeeday

Dosyanız ektedir.

 

[Jeeday]

teşekkürler...

bu formül ile olmaz di mi? illa makro mu olması lazım

 

[Jeeday]

Merhaba,

Module kopyalayıp çalıştırın.
Sayfa isimlerini belirttiğiniz için sadece belirttiğiniz sayfa isimlerinde arama yaptım, eğer kod çalışmadaki tüm sayfalarda çalışacaksa, yani sürekli yeni sayfa ekleyecekseniz sayfalara da döngü kurmakta fayda var.

Sub BenzersizListele()
        
    Dim i As Byte, syf As Worksheet, j As Long, a1, d As Object, deg, dizi()
    
    Set d = CreateObject("Scripting.Dictionary")
    dizi = Array("Sheet1", "Sheet2", "Sheet3")
        
    Application.ScreenUpdating = False
    Sheets("Sheet4").Select
    Range("A:A").ClearContents
    
    For i = 0 To UBound(dizi)
        Set syf = Sheets(dizi(i))
        For j = 1 To syf.Cells(Rows.Count, "A").End(xlUp).Row
            deg = syf.Cells(j, "A")
            If Not d.exists(deg) Then
                d.Add deg, Nothing
            End If
        Next j
    Next i
    
    a1 = d.keys
    Range("A1").Resize(UBound(a1) + 1, 1) = WorksheetFunction.Transpose(a1)

End Sub

.

söylediğiniz durum içinde yapabilir misiniz???

 

[Jeeday]

elimdeki dosyaya uyarlayamadım yanlız bu makroları istediğim orijinal dosyayı yollayacam yarın bakarız tekrar... iyi geceler

 

[Jeeday]

Gerçek dosya

Öncelikle dosyada oluşan hataları yok sayabilirsiniz...

İstediğim şeye gelince... 1, 1İ, 5 ve 27 isimli (sipariş fişleri) 4 tane sheet var. Bunların sayıları müşteriden sipariş geldikçe artmaktadır. 600-700 tane sheet olabiliyor. Ve bu sheetler kendi içinde tarih sıralı olmasına rağmen, sol tarafında bulunan "stok çıkış 01-02-03" sayfasının yanına yeni farklı sayfalar gelebiliyor. yani sipariş fişlerinin konumları değişken olabiliyor. bilmem anlatabildim mi? asıl istediğime gelince, sipariş fişlerindeki K sütunları (2 ve 23. satırlar arasını istiyorum) stok çıkış 01-02-03 sayfasının Q3 hücresine süzülsün...

 

[Jeeday]

Yok mu yardım edebilecek birileri?

 

[Ömer]

Son dosyanızda çok karışık. Ne yapmak istediğiniz anlaşılmıyor.

Son dosya ile ilk dosyanız arasında hiç bir bağlantı göremedim.
Konuyu yeni bir başlık altında yeni dosyanıza göre detaylı bir şekilde açıklayarak sormanızı tavsiye ederim.

 

[Jeeday]

Son dosyaya göre istediğimi anlatayım tekrar... "1, 1İ, 5, 27" olmak üzere 4 tane sayfa var. Bunlar sipariş fişleri. Ve sipariş geldikçe yenileri ekleniyor. Sonunda "İ" ibaresi olanlar ise iade fişleri... Her fişin yada sayfanın K sütununda (K2:K23) satılan ürünlerin kodları var. Bütün satılan ürünleri "STOK ÇIKIŞ 01-02-03" sayfasının Q3 hücresine filtrelenmesini istiyorum...

verdiğiniz kod aslında çalışıyor. tek sorun şu...

dizi = Array("Sheet1", "Sheet2", "Sheet3")

benim kendime uyarlamam için şöyle yapmam lazım

dizi = Array("1", "1İ", "5", "27")

Her yeni sayfa açtığımda sayfa ismini buraya eklemem gerekiyor.

dizi = Array("1:27") mantığında birşey olabiliyor mu acaba? şu sheet ile şu sheet arasındakileri toptan filtrelesin gibi... Siparişler tarih sırasında olduğu için 3 aylık periyotlarla döküm alacam çünkü...

 

[Ömer]

İlk dosyanıza göre sayfa sınırlamalı değil tüm sayfalarda işlem yapan (Sheet4 hariç, çünkü Sheet4 de listeleme yapılmaktadır.) kodlar aşağıdaki gibidir.

Sub BenzersizListele()
 
    Dim i As Integer, syf As Worksheet, j As Long, a1, d As Object, deg
 
    Set d = CreateObject("Scripting.Dictionary")
 
    Application.ScreenUpdating = False
    Sheets("[COLOR=red]Sheet4[/COLOR]").Select
    Range("A:A").ClearContents
 
    For i = 1 To Worksheets.Count
        Set syf = Sheets(i)
        If syf.Name <> "[COLOR=red]Sheet4[/COLOR]" Then
            For j = 1 To syf.Cells(Rows.Count, "A").End(xlUp).Row
                deg = syf.Cells(j, "A")
                If Not d.exists(deg) Then
                    d.Add deg, Nothing
                End If
            Next j
        End If
    Next i
 
    a1 = d.keys
    Range("A1").Resize(UBound(a1) + 1, 1) = WorksheetFunction.Transpose(a1)
 
End Sub

.

 

[Jeeday]

o şekilde olmaz ama... çünkü filtrelenmesini istemediğim sayfalar içeriyor....

 

[Ömer]

o şekilde olmaz ama... çünkü filtrelenmesini istemediğim sayfalar içeriyor....

If syf.Name <> "Sheet4" Then

Yukarıdaki bölüme istemediğiniz sayfa adlarını aşağıdaki gibi yazabilirsiniz.

If syf.Name <> "Sheet4" And syf.Name <> "örnek1" And syf.Name <> "Örnek2" Then

Gibi.

 

[Jeeday]

tmm harika oldu...