Filtreye göre verileri sayfa sayfa ayırma

Katılım
14 Ocak 2011
Mesajlar
32
Excel Vers. ve Dili
EXCEL 2007 TÜRKÇE
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..
 

Ekli dosyalar

Emir Hüseyin Çoban

Destek Ekibi
Destek Ekibi
Katılım
11 Ağustos 2008
Mesajlar
5,893
Excel Vers. ve Dili
Office 2013 Tr - Win10 x64
. . .

Ç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.

. . .
 
Katılım
14 Ocak 2011
Mesajlar
32
Excel Vers. ve Dili
EXCEL 2007 TÜRKÇE
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

Destek Ekibi
Destek Ekibi
Katılım
11 Ağustos 2008
Mesajlar
5,893
Excel Vers. ve Dili
Office 2013 Tr - Win10 x64
. . .

Ö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ı.

. . .
 
Katılım
14 Ocak 2011
Mesajlar
32
Excel Vers. ve Dili
EXCEL 2007 TÜRKÇE
bir kere çalıştırıp bölme işlemi gerçekleştikten sonra tekrar çalıştırmaya gerek kalmayacak.
 

Emir Hüseyin Çoban

Destek Ekibi
Destek Ekibi
Katılım
11 Ağustos 2008
Mesajlar
5,893
Excel Vers. ve Dili
Office 2013 Tr - Win10 x64
. . .

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

. . .
 

Emir Hüseyin Çoban

Destek Ekibi
Destek Ekibi
Katılım
11 Ağustos 2008
Mesajlar
5,893
Excel Vers. ve Dili
Office 2013 Tr - Win10 x64
. . .

Dosyanız ektedir.

Kod:
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
. . .
 

Ekli dosyalar

Katılım
4 Temmuz 2019
Mesajlar
26
Excel Vers. ve Dili
Excel 2016 Türkçe
Çok teşekkür ederim. Benimde işime yaradı
 
Üst