Makro İle Çalışma kitabındaki belirli sekmeleri farklı kaydetme

[serif_007]

Merhabalar;

Bir çalışma kitabım var , bu çalışma kitabı içerisindeki 3 sekmeyi masaüstüne boş bir çalışma kitabının içine formülsüz bir şekilde farklı kaydetmek istiyorum. Çalışma kitabının adı sabit olacak makro içerisine belirtilebilir. Teşekkürler

 

[hgenc545]

Merhaba,

Aşağıdaki kodu deneyin.. Dosya yolunu siz kendiniz belirlemesiniz..






Sub Sayfalari_Kaydet()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim KaynakKitap As Workbook
Dim KaynakSayfa As Worksheet
Dim YeniKitap As Workbook
Dim YeniSayfa As Worksheet


Set KaynakKitap = ThisWorkbook
For Each KaynakSayfa In KaynakKitap.Sheets
Set YeniKitap = Workbooks.Add
Set YeniSayfa = YeniKitap.Sheets(1)
KaynakSayfa.UsedRange.Copy YeniSayfa.Range("A1")

' Tırnak içine siz kendi dosyanızın yorulunuzu girin ama desktop kalsın ki masa üstüne dosyalar kaydedilecek..
YeniKitap.SaveAs "C:\Users\LENOVO\Desktop\" & KaynakSayfa.Name & ".xlsx"
YeniKitap.Close SaveChanges:=False
Next KaynakSayfa

Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox "İşlem tamamlandı!"
End Sub

 

[serif_007]

Merhaba,

Aşağıdaki kodu deneyin.. Dosya yolunu siz kendiniz belirlemesiniz..






Sub Sayfalari_Kaydet()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim KaynakKitap As Workbook
Dim KaynakSayfa As Worksheet
Dim YeniKitap As Workbook
Dim YeniSayfa As Worksheet


Set KaynakKitap = ThisWorkbook
For Each KaynakSayfa In KaynakKitap.Sheets
Set YeniKitap = Workbooks.Add
Set YeniSayfa = YeniKitap.Sheets(1)
KaynakSayfa.UsedRange.Copy YeniSayfa.Range("A1")

' Tırnak içine siz kendi dosyanızın yorulunuzu girin ama desktop kalsın ki masa üstüne dosyalar kaydedilecek..
YeniKitap.SaveAs "C:\Users\LENOVO\Desktop\" & KaynakSayfa.Name & ".xlsx"
YeniKitap.Close SaveChanges:=False
Next KaynakSayfa

Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox "İşlem tamamlandı!"
End Sub

Merhabalar , cevabınız için teşekkür ederim. Fakat ben sadece belirli sekmeleri kaydetmek istiyorum. Üstteki kod ile tüm sayfaları tek tek kaydediyor. Benim Yapmak istediğim şey şu. Yeni bir kitap oluşturacak ve içerisine benim istediğim 3 sekmeyi farklı kaydedecek.

 

[rapstar_bg]

Sub SayfalarıKaydet()
    Dim KaydetKitap As Workbook
    Dim Sayfa As Worksheet
    Dim KaydetYolu As String
    Dim KaydetAdi As String
    
    ' Kaydetme konumu ve dosya adını belirleyin
    KaydetYolu = "C:\Users\KULLANICIADI\Desktop\" ' Masaüstü konumunu değiştirebilirsiniz
    KaydetAdi = "YeniKitap.xlsx" ' Yeni dosya adını belirleyin
    
    ' Yeni kitap oluşturun ve kaydetme konumuna yerleştirin
    Set KaydetKitap = Workbooks.Add
    KaydetKitap.SaveAs KaydetYolu & KaydetAdi
    
    ' Her bir sayfayı kopyalayın ve yeni kitaba yapıştırın
    For Each Sayfa In ThisWorkbook.Sheets(Array("Sayfa1", "Sayfa2")) ' Sayfa isimlerini değiştirebilirsiniz
        Sayfa.Copy After:=KaydetKitap.Sheets(KaydetKitap.Sheets.Count)
    Next Sayfa
    
    MsgBox "Sayfalar başarıyla kaydedildi."
End Sub

Bu kod kaynak kitaptaki "Sayfa1" ve "Sayfa2" isimli sayfaları kopyalar ve "YeniKitap.xlsx" isimli yeni kitaba, masaüstüne kayıt eder.

 

[serif_007]

Sub SayfalarıKaydet()
    Dim KaydetKitap As Workbook
    Dim Sayfa As Worksheet
    Dim KaydetYolu As String
    Dim KaydetAdi As String
   
    ' Kaydetme konumu ve dosya adını belirleyin
    KaydetYolu = "C:\Users\KULLANICIADI\Desktop\" ' Masaüstü konumunu değiştirebilirsiniz
    KaydetAdi = "YeniKitap.xlsx" ' Yeni dosya adını belirleyin
   
    ' Yeni kitap oluşturun ve kaydetme konumuna yerleştirin
    Set KaydetKitap = Workbooks.Add
    KaydetKitap.SaveAs KaydetYolu & KaydetAdi
   
    ' Her bir sayfayı kopyalayın ve yeni kitaba yapıştırın
    For Each Sayfa In ThisWorkbook.Sheets(Array("Sayfa1", "Sayfa2")) ' Sayfa isimlerini değiştirebilirsiniz
        Sayfa.Copy After:=KaydetKitap.Sheets(KaydetKitap.Sheets.Count)
    Next Sayfa
   
    MsgBox "Sayfalar başarıyla kaydedildi."
End Sub

Bu kod kaynak kitaptaki "Sayfa1" ve "Sayfa2" isimli sayfaları kopyalar ve "YeniKitap.xlsx" isimli yeni kitaba, masaüstüne kayıt eder.

Çok teşekkür ederim