Çalışma Sayfasını farklı isimle kaydetmek

[sbayyigit]

Arkadaşlar Aynı çalışma kitabında, sayfa1 de çalışırken bu sayfayı a1 hücresindeki "Yeni" adıyla farklı bir sayfa olarak keydetmek istiyorum. vba kodunu nasıl oluşturabilirim.

 

[asi_kral]

Arkadaşlar Aynı çalışma kitabında, sayfa1 de çalışırken bu sayfayı a1 hücresindeki "Yeni" adıyla farklı bir sayfa olarak keydetmek istiyorum. vba kodunu nasıl oluşturabilirim.

Merhaba
Sayfa1'deki değişiklikler kayıt edilecek mi_?
Dosya eklerseniz yardımcı olurum sanırım.

 

[sbayyigit]

sayfa1 olduğu gibi kalacak bir kopyası da a1 hücresindeki değerle yeni bir sayfa olacak yani sayfa1 in kopyası olacak.

 

[asi_kral]

sayfa1 olduğu gibi kalacak bir kopyası da a1 hücresindeki değerle yeni bir sayfa olacak yani sayfa1 in kopyası olacak.

Yani Şablon mu olacak_?
Dosya eklememişsiniz_?

 

[sbayyigit]

örnekte açıklama var.

 

[asi_kral]

örnekte açıklama var.

Merhaba
Kodu boş bir module ekleyin ve deneyin.

Option Explicit
Sub sayfaları_farklı_keydet_1967()
'Konu       :   Sayfaları Farklı Kaydet
'Mail       :   m.batu.1967@gmail.com
'Coder By   :   asi_kral_1967
Dim asi
For asi = 2 To Sheets.Count
If Sheets(asi).Name <> Range("A1") Then
Sheets("Sayfa1").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = Range("A1")
Else
MsgBox "Bu Sayfa Var", vbCritical, "asi_kral_1967"
End If
Next
End Sub

Eki İnceleyiniz.

 

[sbayyigit]

Option Explicit
Sub sayfaları_farklı_keydet_1967()
Dim asi
asi = Sheets.Count
Sheets("sayfa1").Copy After:=Sheets(Sheets.Count)
'Sheets(Sheets.Count).Select
ActiveSheet.Name = Range("a1")
End Sub


bu şekilde oldu. teşekkür ederim.

 

[asi_kral]

Option Explicit
Sub sayfaları_farklı_keydet_1967()
Dim asi
asi = Sheets.Count
Sheets("sayfa1").Copy After:=Sheets(Sheets.Count)
'Sheets(Sheets.Count).Select
ActiveSheet.Name = Range("a1")
End Sub


bu şekilde oldu. teşekkür ederim.

Yalnız kod hata verir aynı sayfa olduğunda dikkat edin.
Kırmızı yere gerek yok
Kolay Gelsin.

 

[sbayyigit]

Yalnız kod hata verir aynı sayfa olduğunda dikkat edin.
Kırmızı yere gerek yok
Kolay Gelsin.

Asi kral Hocam İlgin için teşekkürler. kodu düzenlemiştim. bana gereken yerdi orası.

Sub farkli_kaydet()
Dim asi
For asi = 2 To Sheets.Count
If Sheets(asi).Name = Sheets("ayaktan").Range("c5").Value Then
MsgBox "Bu Sayfa Var", vbCritical, "Uyarı"
Exit Sub
End If
Next
Sheets("ayaktan").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = Range("c5")
End Sub

 

[asi_kral]

Asi kral Hocam İlgin için teşekkürler. kodu düzenlemiştim. bana gereken yerdi orası.

Sub farkli_kaydet()
Dim asi
For asi = 2 To Sheets.Count
If Sheets(asi).Name = Sheets("ayaktan").Range("c5").Value Then
MsgBox "Bu Sayfa Var", vbCritical, "Uyarı"
Exit Sub
End If
Next
Sheets("ayaktan").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = Range("c5")
End Sub

Kolay Gelsin.
Kusura bakmayın genelde kısır bir döngü yada hatalara karşı takıntım mevcut ondan biraz kodu uzatırım ama bu hataları ve kısırlığı ortadan kaldırmaya çalışırım.