Sayfayı başka sayfalar yaratarak bölmek

[telefoncuk]

Merhaba,

Problem şu şekilde;
Örneğin Türkiye bölgelerinden ve burdaki bayilerden oluşan bir liste var,

Marmara-x bayi-150
Marmara-y bayi-300
Marmara-z bayi-500
Ege-t bayi-50
Ege-v bayi- 75

Bu şekilde giden uzun bir liste olduğunu düşünün, bunu her seferinde bölgelere göre ayırmam gerekiyor. Yani listede sadece Marmara'nın bayileri kalacak şekilde diğer bayileri siliyorum. Yeni bir sayfa oluşturuyorum, sonra Ege için, İç anadolu için vs. Ama bu işlemi sürekli yaptığım için epey bir vakit kaybı oluyor.

Bu işlemi makro ile nasıl yapabiliriz?

Yardımlarınız için şimdiden çok teşekkürler.

 

[Emir Hüseyin Çoban]

. . .

Örnek dosya yüklerseniz veriler hangi sütunlarda görebiliriz.
Buna göre Marmara içermeyenleri sil işlemi yaptırılabilir.

. . .

 

[savas_145]

Ustam senin çalışma sayfandan ufak bir örnek gönder. Makronu hazirlayayim

 

[telefoncuk]

dosyayı ekledim.

çok teşekkürler,

 

[Emir Hüseyin Çoban]

. . .

Sub kod()
    Application.ScreenUpdating = False
    Dim SD As Worksheet: Set SD = Sheets("Sheet1")
    Dim liste(), dizi()
    
    son = SD.Cells(Rows.Count, "A").End(3).Row
    liste = SD.Range("A2:C" & son).Value
    Set dic = CreateObject("scripting.dictionary")
    For x = 1 To UBound(liste, 1)
        aranan = liste(x, 1)
        If Not dic.exists(aranan) Then
            dic.Add aranan, ""
            n = n + 1
            ReDim Preserve dizi(1 To son, 1 To 1)
            dizi(n, 1) = liste(x, 1)
        End If
    Next x
    
    For i = 1 To n
        a1 = dizi(i, 1)
        
        With SD
            On Error Resume Next
            If Not .AutoFilterMode Then
                .Range("A1").AutoFilter
            Else
                .ShowAllData
            End If
            .Range("A1").AutoFilter Field:=1, Criteria1:=a1
            
            SD.Select
            Sheets.Add
            .AutoFilter.Range.Copy Range("A1")
            Cells.EntireColumn.AutoFit
        End With
    Next i
    
    On Error Resume Next
    SD.ShowAllData
    On Error GoTo 0
    SD.select
    Application.ScreenUpdating = True
    
    MsgBox "B i t t i "
End Sub

. . .

 

[telefoncuk]

Çok teşekkür ederim, elinize sağlık.
Bir sorum daha olacak, bunu ayrı bir dosya haline getirmek istersem nasıl bir değişiklik yapmam gerekiyor? Yani her bölgenin ayrı dosyasını oluşturmak istersem?

 

[Emir Hüseyin Çoban]

. . .

Ayırmak istediğiniz sayfaları Ctrl tuşuna basarak mouse ile seçin.
Bu sayfa isimleri üzerinde sağ tıkla > Taşı veya kopyala > açılan pencereden
kitap: kısmında (yeni kitap) seçin
alt kısımdan kopya oluşturu işaretleyin.
İşlemi bitirin.

. . .