excel sayfalara ayırma

[Onurssssss]

Merhaba,
A sütunundaki numaralara göre aynı çalışma kitabında " numara 1" "numara 2" diye sayfalara bölmek istiyorum yardımcı olabilir misiniz

 

[Muzaffer Ali]

Merhaba.

Bir modüle kopyalayıp deneyiniz.

Sub test()
    Dim Bak As Long
    Dim BakSira As Long
    Dim syfAna As Worksheet
    Dim syfYeni As Worksheet
    
    Set syfAna = ThisWorkbook.Worksheets("Sayfa1")
    
    For Bak = 2 To syfAna.Cells(Rows.Count, "A").End(xlUp).Row
        Set syfYeni = ThisWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count))
        syfYeni.Name = "Numara " & syfAna.Cells(Bak, "A")
        syfYeni.Range("A1:E1").Value = syfAna.Range("A1:E1").Value
        For BakSira = Bak + 1 To syfAna.Cells(Rows.Count, "A").End(xlUp).Row + 1
            If syfAna.Cells(Bak, "A") <> syfAna.Cells(BakSira, "A") Then
                syfYeni.Range("A2:E" & 1 + BakSira - Bak).Value = syfAna.Range("A" & Bak & ":E" & BakSira).Value
                Bak = BakSira - 1
                Exit For
            End If
        Next
    Next
End Sub