Sayfadan Sayfaya Filtreme Sorunu!

[InfoTech]

Sayfadan Sayfaya Filtreleme!

Öncelikle Merhabalar Aranıza Dün Katıldım ve İhracat Yapan Bir Tekstil Firmasının Bilgi işlem Sorumlusuyum...

Benim Problemim;

Firmamızda Kullanılan Üretim Takip Programımın Bazen İstenilen Raporlama Sistemini Bana Vermemesi...

Bende Raporda İşime Yarıyacak Olan Bölümlerinin Filtreleyerek Farklı Bölümlere Yazılmasını Sağladım....

Ekteki Dosyada Görüleceği Gibi Genel Kısmında Bulunan Bölüm Üretim Takip Programı İle Alınmış Soft Bir Rapordur...

Ancak Ben Bu Raporu Aldıktan Sonra İşime Yaramayan Sütunları Farklı Bir Sayfada Kodlarla Eledim ve Filtreli Rapor Bölünü Oluşturdum..

Öyle Bir Durum Söz Konusu Olmalı ki Filtreli Rapor Bölümünde Aynı Olan Sipariş Gurupları Kendi İsmi İle Aynı Olan Farklı Bir Sayfaya Kopyalansın...

Mesela Filtreli Raporda Bulunan Örme İsimsinli Sipariş Gurupları "Örme" İsimli Bir Sayfaya Satır Satır Kopyalanmalı.

Dün Gece Forumlara Bu Konuyu Çözebilirim Ümidiyle Baktım Ancak En İyisi Sizden Yardım Alarak Çözebileceğimi Düşündüm...

Şimdiden Teşekkürler... :yardim:

Ekli dosyayı görüntüle 46154 :???:

 

[InfoTech]

Bu Konuyla Alakalı Kimsenin Yorumu yada Cevabı Yok mu yada Ben mi Anlatamadım???

 

[Ferhat Pazarçevirdi]

Aşağıdaki kodları standart bir modül sayfasına kopyalaıp, çalıştırınız. Bir butona da atayabilirsiniz.

Option Explicit
Sub Sayfalara_Ayristir()
    Dim i As Integer
    Dim j As Integer
    Dim son As Integer
    Dim col As New Collection
    Dim arr()
    Dim sh As Worksheet
    Dim shG As Worksheet
 
    Set shG = Sheets("Genel")
    
    arr = Array("Sip.Grubu", "Müşteri", "Sipariş No", _
                "Model", "Sipariş Adedi", "Kesim Adedi", _
                "Üretim Durumu", "Sipariş Tarihi", "Sevk Tarihi")
   
    On Error Resume Next
    
    With shG
        For i = 2 To .Cells(65536, 1).End(xlUp).Row
            If Not IsEmpty(.Cells(i, 1)) Then
                col.Add .Cells(i, 4), .Cells(i, 4)
            End If
        Next i
    End With
    
    For i = 1 To col.Count
        
        With Application
            .DisplayAlerts = False
            Sheets(CStr(col(i))).Delete
            .DisplayAlerts = True
        End With
        
        Set sh = Sheets.Add(, Sheets(1))
        
        With sh
            .Name = col(i)
            For j = 1 To UBound(arr)
                .Cells(1, j) = arr(j)
            Next j
        
            For j = 2 To shG.Cells(65536, 1).End(xlUp).Row
                If shG.Cells(j, 4) = col(i) Then
                    son = .Cells(65536, 1).End(xlUp).Row + 1
                    .Cells(son, 1) = shG.Cells(j, 4)
                    .Cells(son, 2) = shG.Cells(j, 1)
                    .Cells(son, 3) = shG.Cells(j, 2)
                    .Cells(son, 4) = shG.Cells(j, 5)
                    .Cells(son, 5) = shG.Cells(j, 9)
                    .Cells(son, 6) = shG.Cells(j, 21)
                    .Cells(son, 7) = ""
                    .Cells(son, 8) = shG.Cells(j, 22)
                End If
            Next j
        End With
    
    Next i
    
    On Error GoTo 0
        
    Set sh = Nothing
    Set shG = Nothing
    
End Sub

 

[InfoTech]

Hocam Yardımlarınızdan Dolayı Çok Tşk Ederim Çok Sağolun....

 

[InfoTech]

Hocam affınıza Sığınarak Bişey Daha Sormak İstiyorum Kodlara Baktığım Kadarıyla Her Bir Veriyi Sayfaları Sıralayarak Atıyor Peki Karakter ve Sayfa Yapısını Değiştirmeden Nasıl Filreleme Yapabilirim... VBA'dan Baktığımda Sayfa Numaraları Devamlı Değişiyor... Mesela Amacım Rapor Alındığında Kitap1'in Sayfa4'den Okunan Verilen Filtre.xls'in Genel Bölümüne Yazılsın.. Ufff Bu İş Çok Karmaşık..