Sayfalara Ayırma Hk

bkk

Altın Üye
Katılım
30 Aralık 2019
Mesajlar
186
Excel Vers. ve Dili
Ofis 2019
Altın Üyelik Bitiş Tarihi
06-12-2025
Merhabalar,
Ekte bulunan Excel kitabında ham veri sayfasını N sütununa göre sayfalara ayırdım ancak elimdeki liste çok büyük, forumdaki örneklerle başarılı olamadım, örnekteki durumun vba çözümü için yardımcı olabilir misiniz,
Teşekkürler şimdiden,
 

Ekli dosyalar

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,646
Excel Vers. ve Dili
Pro Plus 2021
Kod:
Sub test()
    Dim param(1 To 3)

    With Application
        param(1) = .ScreenUpdating: .ScreenUpdating = False
        param(2) = .DisplayAlerts: .DisplayAlerts = False
        param(3) = .Calculation: .Calculation = xlCalculationManual
    End With

    Dim s1 As Worksheet, son&, i&, lst, ky, kys, sh As Worksheet

    Set s1 = Sheets("HAM VERİ")
    s1.Select

    son = s1.Cells(Rows.Count, "N").End(3).Row
    lst = Range("N3:N" & son).Value

    With CreateObject("Scripting.Dictionary")

        For i = 1 To UBound(lst)
            .Item(lst(i, 1)) = Null
        Next i
        kys = .keys
        .RemoveAll

        For Each sh In Worksheets
            .Item(sh.Name) = Null
        Next

        For Each ky In kys
            If .exists(ky) Then Sheets(ky).Delete
            s1.Copy after:=ActiveSheet
            ActiveSheet.Name = ky
            ActiveSheet.Range("$A$2:$AH$5").AutoFilter Field:=14, Criteria1:="<>" & ky
            Rows("3:" & son).Delete
            Selection.AutoFilter
        Next ky

    End With
    s1.Select

    With Application
        .ScreenUpdating = param(1)
        .DisplayAlerts = param(2)
        .Calculation = param(3)
    End With

End Sub
 
Son düzenleme:

bkk

Altın Üye
Katılım
30 Aralık 2019
Mesajlar
186
Excel Vers. ve Dili
Ofis 2019
Altın Üyelik Bitiş Tarihi
06-12-2025
tesekkür ederim elinize sağlık
 
Üst