Sayfayı kitap olarak kayıt yapma

[Excelexcellent]

Merhaba
Excel çalışma kitabımda 5 farklı sayfa var. Aşağıda görülen kodlar kitabı aynı şekilde tüm sayfaları ile yeni kitap olarak kayıt yapıyor.
Yapmaya çalıştığım sadece "Sayfa2" yi yeni bir kitap olarak kayıt yapmak. Birde yeni kayıt yapılan kitap asıl kitap da olan vba kodlarını içermemeli yani makrolar kayıt yapılmayacak.
Yardımınız için teşekkür ederim.

Private Sub CommandButton1_Click()
Dim evn As Object, yol As String, dosya As String, klasor As String
Set evn = CreateObject("scripting.filesystemobject")
yol = "D:\"
dosya = "" & Format(Worksheets("Sayfa1").Range("A1").Value, "mmmm") & ""
klasor = "ARŞİV"
If Not evn.FolderExists(yol & klasor) Then
    evn.CreateFolder yol & klasor
    ActiveWorkbook.SaveCopyAs Filename:=yol & klasor & "\" & dosya & ".xls"
Else
    ActiveWorkbook.SaveCopyAs Filename:=yol & klasor & "\" & dosya & ".xls"
End If
Set evn = Nothing
End Sub

 

[halit3]

arama yapsaydınız buna benzer bir sürü örnekler mevcutdu.

bu kodu denirmisiniz.

Private Sub CommandButton1_Click()
deger = Format(Worksheets("Sayfa1").Range("A1").Value, "mmmm")
Sayfa_adı = "Sayfa2"
On Error Resume Next
Kaynak = "D:\ARŞİV"
If Dir(Kaynak) = "" Then MkDir (Kaynak)
On Error Resume Next
Dim sayfa As Worksheet
For Each sayfa In Worksheets
MsgBox Worksheets
If sayfa.Name = Sayfa_adı Then
sayfa.Copy
ActiveSheet.DrawingObjects.Delete
vbprojectsil
ActiveWorkbook.saveas Kaynak & "\" & deger & ".xls", FileFormat:=xlExcel2
ActiveWorkbook.Close False
Exit Sub
End If
Next sayfa
End Sub
Sub vbprojectsil()
For Each component In ActiveWorkbook.VBProject.VBComponents
If component.Type <> 100 Then
ActiveWorkbook.VBProject.VBComponents.Remove component
Else
Set modul = component.CodeModule
modul.DeleteLines 1, modul.CountOfLines
End If
Next
End Sub

 

[Excelexcellent]

Sayın Halit ÖZDEMİR
Konu ile ilgilendiğiniz için teşekkür ederim.
Forumda sayfayı kitap olarak kaydetme örneklerini araştırdım uygulamaya çalıştım ancak yapamadığım için yardım istemek zorunda aldım. Özellikle VBA konusunda kendimi geliştirebilmek için forumu sürekli takip ediyorum. Sizin ve diğer arkadaşlarımızın eklediği örnek dosyaları ve çalışmaları sürekli inceliyorum.

Halit bey, verdiğiniz kodları uyguladım. D sürücüsünde ARŞİV klasörü açıyor ama klasör boş, sayfayı kitap olarak kaydetmiyor. Daha net anlaşılabilmesi için örnek dosyamı gönderiyorum.
Teşekkür ederim.

 

[halit3]

dosyanı açar açmaz sayfa2 yi d\arşiv klasörüne ANAMENÜ olarak dosyayı kayıt yaptı burada işlem doğru zannediyorsam formatda sıkıntı var ben ofis 2000 kullanıyorum sizinki ofis 2007 burada yapılması gereken

ActiveWorkbook.SaveAs Kaynak & "\" & deger & ".xls", FileFormat:=xlExcel2

FileFormat:=xlExcel2 formatını değiştirmelisiniz yada virgül ve virgülden sonrasını iptal etmelisiniz.

xlExcel2 bunun yerine aşağıdakilerden birini deneyiniz.

xlExcel9795
xlExcel3
xlExcel4
xlExcel7
xlExcel8

 

[Excelexcellent]

Halit bey, teşekkür ederim tam istediğim gibi.
İlgili kod satırında virgülden sonra - "FileFormat:=xlExcel8 - uyguladım işlem tamam.

Ayrıca, eğer aynı isimde dosya var ise uyarı vermeden üzerine kayıt yapıp güncellenmesi için aşağıda kırmızı font ile görülen satırları ekledim ama yinede "bu dosya var değiştirilsin mi ? " diye soruyor. Acaba kodlar mı yanlış ? yoksa yanlış yere mi yazdım.

ActiveWorkbook.SaveAs Kaynak & "\" & deger & ".xls", FileFormat:=xlExcel8, _
        [COLOR="Red"]Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False[/COLOR]
ActiveWorkbook.Close False

 

[Excelexcellent]

İşlem tamam.
Aksik yazdığım kodu buldum.

Application.DisplayAlerts = False

 

[halit3]

kırmızı yazan kadu siyah yazan kodların arasına koyarakda kullanabilirsin

On Error Resume Next
Kill Kaynak & "\" & deger & ".xls"
Dim sayfa As Worksheet

 

[Excelexcellent]

Sayın Halit
Teşekkür ederim benim için faydalı bir bilgi oldu.
Saygılarımla.