Filtreye göre verileri sayfa sayfa ayırma

[punkek]

merhaba,

Elimde bir data seti olsun ve bir sütunda 3 ayrı bölgem var. bu data setini bölgelere göre 3 ayrı sayfaya bölmek istiyorum. kod ile nasıl yapabilirim? ingilizce bir kaç kaynak buldum ancak kodlar çok karışık geldi. biraz açıklamalı anlatırsanız çok faydalı olacak. örnek dosya ekledim. çok teşekkürler..

 

[Emir Hüseyin Çoban]

. . .

Çalışmanın daha kapsamlı ve kullanışlı olması için.
Bölge sayısı sabit mi her zaman bu 3 bölge mi olacak.

Yoksa değişken mi, önce bölge sayısı mı tespit edilmeli.

Bölge isimlerinin sayfalarını siz mi açacaksınız, kod ile mi açtıralım.

. . .

 

[punkek]

hayır veriler hep değişken olacak o nedenle bölge sayısı da değişebilir. sayfaları otomatik açsa daha iyi olur. bir çok raporda sürekli kullanacağım bir yapı olacak. tşk.

 

[Emir Hüseyin Çoban]

. . .

Örneğin kodu bir kez çalıştırdınız ve bölgelere göre Sayfa1 deki verileri dağıttı.

Kodları tekrar çalıştırdığınızda Sayfa1 deki verileri tekrar dağıtmayacak değil mi ?
Sadece yeni girilen verileri mi dağıtmalı.

. . .

 

[punkek]

bir kere çalıştırıp bölme işlemi gerçekleştikten sonra tekrar çalıştırmaya gerek kalmayacak.

 

[Emir Hüseyin Çoban]

. . .

Üzerinde çalışıp, birazdan dosya yüklerim.

. . .

 

[Emir Hüseyin Çoban]

. . .

Dosyanız ektedir.

Function SayfaVarMi(Sayfa As String) As Boolean
    On Error Resume Next
    SayfaVarMi = CBool(Len(Worksheets(Sayfa).Name) > 0)
End Function


Sub Kod()
    Application.ScreenUpdating = False
    Dim S1 As Worksheet
    Set S1 = Sheets("Sayfa1")
    Dim Sayfa As String
    
    For a = 2 To S1.Cells(Rows.Count, "B").End(3).Row
        Sayfa = S1.Cells(a, "B")
        If Not SayfaVarMi(Sayfa) Then
            Sheets.Add
            ActiveSheet.Name = Sayfa
            Sheets(Sayfa).Move After:=Sheets(Sheets.Count)
            S1.Range("A1:H1").Copy Range("A1")
            
        End If
        sonsatır = Sheets(Sayfa).Cells(Rows.Count, "A").End(3).Row + 1
        S1.Range(S1.Cells(a, "A"), S1.Cells(a, "H")).Copy _
        Sheets(Sayfa).Cells(sonsatır, "A")
    Next a
    Application.ScreenUpdating = True
    MsgBox " B i t t i "
End Sub

. . .

 

[punkek]

çok teşekkür ederim elinize sağlık,

 

[Bulmacaa]

Çok teşekkür ederim. Benimde işime yaradı