Tek sayfayi farkli kaydetmek istiyorum

[BYSERTTAS]

Selamlar aşağıdaki kod ile tüm sayfaları ayırıp farklı kayıt yapıyorum. Benim yapmak istedigim ise seçeceğim belirli sayfaları farklı kaydetmek. Yardımcı olursanız sevinirim.

Sub sayfalara_ayir()
Application.DisplayAlerts = False
Dim sayfa As Worksheet, kitap As Workbook
For Each sayfa In ThisWorkbook.Sheets
If sayfa.Name <> "Genel" Then
Set kitap = Workbooks.Add
sayfa.Copy kitap.Sheets(1)
kitap.SaveAs ThisWorkbook.Path & "\" & sayfa.Name & ".xls", xlExcel8
kitap.Close False
End If
Next sayfa
Set sayfa = Nothing
Application.DisplayAlerts = True
MsgBox "İşlem Tamamlandı.", vbInformation, "BİLGİ"
End Sub

 

[veyselemre]

Case kısmına işlem yapılacak sayfaları ekleyin.

Sub sayfalara_ayir()
    Application.DisplayAlerts = False
    Dim sayfa As Worksheet, kitap As Workbook
    For Each sayfa In ThisWorkbook.Sheets
        
        Select Case sayfa.Name
            
            Case "Sheet2", "Sayfa 2"             'işlem yapılacak sayfalar
                Set kitap = Workbooks.Add
                sayfa.Copy kitap.Sheets(1)
                kitap.SaveAs ThisWorkbook.Path & "\" & sayfa.Name & ".xls", xlExcel8
                kitap.Close False
 
        End Select

    Next sayfa
    Set sayfa = Nothing
    Application.DisplayAlerts = True
    MsgBox "İşlem Tamamlandı.", vbInformation, "BİLGİ"
End Sub

 

[BYSERTTAS]

Teşekkürler ustat hurmetler