Yedekle Makrosu'na ilave

[1Al2Ver]

Merhabalar,

Aşağıdaki kod ile, çalışma kitabındaki "fatura" isimli sayfayı C:\Fatura adlı klasöre yedekliyorum,

İsteğim, "fatura" isimli sayfanın belirli bir bölümünü, örneğin A1:G25 aralığını yedekletmek,

Bu işlevi için kod'a yapılacak ilaveyi rica ediyorum, teşekkür ederim.


Sub Yedekle()
Dim wb As Workbook, i%, sor&

Set wb = Workbooks.Add

For i = 1 To Sheets.Count
wb.Sheets(i).Name = i
Next

ThisWorkbook.Sheets("fatura").Copy _
Before:=Workbooks("" & wb.Name).Sheets(1)

Application.DisplayAlerts = False
For i = 1 To wb.Sheets.Count - 1
wb.Sheets("" & i).Delete
Next

On Error Resume Next
MkDir "C:\fatura\"

On Error GoTo 0
With ThisWorkbook.Sheets("fatura").[c2]

If Dir("C:\fatura\" & .Value & ".xls") <> "" Then
sor = MsgBox("'C:\fatura\" & .Value & ".xls" & _
"' mevcuttur! Üzerine yazılsın mı?", vbYesNo + vbExclamation)

If sor = vbYes Then
Kill "C:\fatura\" & .Value & ".xls"
Else
Exit Sub
End If
End If

wb.SaveAs "C:\fatura\" & .Value & ".xls"
wb.Close False

End With

Application.DisplayAlerts = True

End Sub

 

[Skorpiyon]

Sayın 1Al2Ver,

Aşağıdaki kod bloğuna kırmızı alanı ekleyerek bir dener misiniz.


ThisWorkbook.Sheets("fatura").Range("A1:G25").Copy _
Before:=Workbooks("" & wb.Name).Sheets(1)

 

[1Al2Ver]

Sayın 1Al2Ver,

Aşağıdaki kod bloğuna kırmızı alanı ekleyerek bir dener misiniz.


ThisWorkbook.Sheets("fatura").Range("A1:G25").Copy _
Before:=Workbooks("" & wb.Name).Sheets(1)

Merhaba,

İlginiz için teşekkür ederim, ancak ilave kod,

Hata (400) mesajı verdi ve boş bir excel sayfası yarattı,

Saygılarımla.

 

[1Al2Ver]

Merhaba,

Kod'a ilave veya aynı işlemi görebilen farklı bir kod rica ediyorum,

Teşekkür ederim.

 

[Skorpiyon]

Sayın 1Al2Ver,

Aşağıdaki kodu verdiklerimle değiştirerek bir denermisiniz.


ThisWorkbook.Sheets("fatura").Copy _
Before:=Workbooks("" & wb.Name).Sheets(1) 'Bu kodu silin ve aynı aralığa aşağıdakini yazın.

Windows("1Al2Ver.xls").Activate 'Kopyalanacak verinin olduğu kitap ismi olacak.
Sheets("fatura").Select
[A1:G25].Copy
Windows("" & wb.Name).Activate
Sheets(1).Select
Range("A1").PasteSpecial

 

[1Al2Ver]

Sayın 1Al2Ver,

Aşağıdaki kodu verdiklerimle değiştirerek bir denermisiniz.


ThisWorkbook.Sheets("fatura").Copy _
Before:=Workbooks("" & wb.Name).Sheets(1) 'Bu kodu silin ve aynı aralığa aşağıdakini yazın.

Windows("1Al2Ver.xls").Activate 'Kopyalanacak verinin olduğu kitap ismi olacak.
Sheets("fatura").Select
[A1:G25].Copy
Windows("" & wb.Name).Activate
Sheets(1).Select
Range("A1").PasteSpecial

Sayın Şaban Sertkaya,merhaba,

Öncelikle zahmetleriniz ve çözümü önemsemeniz adına bir kez daha teşekkür ederim,

Ben bir hata yapıyor da olabilirim, kodu çok değişik şekillede anılan aralıkta denedim, ancak bu haliyle aktarılan sayfa boş gelmekte ve sayfa adı da "3" olmakta,

Ek'li dosyaya bakarak bir çözüm alırsam memnun olacağım,

Teşekkür ederim.

 

[Skorpiyon]

ThisWorkbook.Sheets("fatura").Copy _ 'BU SATIRI DA SİLMELİNİZ.
Before:=Workbooks("" & wb.Name).Sheets(1) 'Bu kodu silin ve aynı aralığa aşağıdakini yazın.

Açıklama 1 :
Kod yazımında _ (alt çizgi) işareti kodun aslında bitmediğini, satırın uzun olmasından dolayı, kodları daha rahat görebilmek amacıyla alt satıra geçildiğini göstermek için koyulur.
Bu kodu silin dediğimde üstündeki satırı da silmeniz gerekirdi.

Açıklama 2:
Yeni açılan çalışma kitabında sayfa isminin 3 olmasını verdiğiniz kodlar sağlamaktadır. Aksi takdirde zaten sayfa isimleri : Sayfa1, Sayfa2 ve Sayfa3 olacaktı.
Şu komutlar sayfa ismini 1,2,3 olarak değiştirmektedir;

For i = 1 To Sheets.Count (i için sayfaları say (1 den mevcut sayfa sayısına kadar diyor))
wb.Sheets(i).Name = i (Eklenen kitapta.Sayfa(1).İsmi = 1 olacak diyor)
Next (Döngü gerçekleştikçe mevcut sayfa isimleri 2, 3 diye devam edecektir)

Açıklama 3:
Şu satırlar sayfaları silmek için kullanılıyor

For i = 1 To wb.Sheets.Count - 1 (Eklenen kitapta mevcut sayfa sayısından 1 eksik say)
wb.Sheets("" & i).Delete (Eklenen kitapta.sayfa.1'i sil)
Next (Döngü devam ettikçe en son sayfaya kadar sil (En sonuncu hariç))

Zaten bir kitapta tüm sayfaları silemezsiniz. Excel müsade etmez. En az 1 sayfa olmak zorunluluğu vardır.


Ek'li dosyayı inceleyin. "Makro Kaydet" yöntemi ile yapılmıştır.
(Sadece dosyayı kaydederken ismini K1'den alması sağlanmıştır.)

 

[1Al2Ver]

ThisWorkbook.Sheets("fatura").Copy _ 'BU SATIRI DA SİLMELİNİZ.
Before:=Workbooks("" & wb.Name).Sheets(1) 'Bu kodu silin ve aynı aralığa aşağıdakini yazın.

Bu kodu silin dediğimde üstündeki satırı da silmeniz gerekirdi.

Şaban bey merhaba,

Kod ve açıklamalar için teşekkür ederim,

1) Bu kodu silerek te deneme yapmış ve sonuç alamamıştım,

2) Sayfa2 veya sayfa3......, sayfa28 de çalışırken de, sayfa28'i yedeklemem gerektiğinde kodun değişmesi gerekecek sanırım,

ActiveSheet.Paste 'Aktif Kitaba yapıştır (İlk sayfa1 etkin olur)
Sheets("Sayfa2").Delete 'Sayfa2'yi sil ,
Sheets("Sayfa3").Delete 'Sayfa3'ü sil ,

Yukarıdaki kod ; "aktif sayfanın adı ne ise ( fatura, sayfa1, sayfa28 ) sayfayı o isimle kayıt et, aktif olmayanları sil" olabilir mi ?

Bu şekliye 28 adet sayfaya buton atayacağım, ( böylece her sayfa ve buton için kodu, sayfaya göre düzenlememiş olacağım )

Sonuç olarak ; sayfa1--sayfa28 arasında olan bir çalışma kitabında, aktif sayfa da çalışılırken yedekleme yaptığımda, yedeklenen sayfa, aktif sayfadaki ( örn; sayfa28 ) K1'e göre C:\FATURA klasörüne kopyalanacak, K1'e göre isim alan dosya açıldığında ise, sayfanın adı "sayfa28" olarak görülecek,

Sizi yorduğum için kusuruma bakmayın, şayet olabiliyor ise memnun kalırım,

Tekrar teşekkür ederim.

 

[halit3]

alternatif dosya ekliyorum

 

[1Al2Ver]

alternatif dosya ekliyorum

Sayın halit3 merhaba,

Alternatif çözüm için çok çok teşekkür ederim, fazlası ile işimi görmektedir,

Hemen dönemedim, önce elektrikler kesildi, sonra da net'te sorun çıktı, sorunu ancak halledebildim, bu nedenlerle cevabım gecikti, kusuruma bakmayın,

Tekrar teşekkür ederim, saygılarımla.

 

[halit3]

Sayın halit3 merhaba,

Alternatif çözüm için çok çok teşekkür ederim, fazlası ile işimi görmektedir,

Hemen dönemedim, önce elektrikler kesildi, sonra da net'te sorun çıktı, sorunu ancak halledebildim, bu nedenlerle cevabım gecikti, kusuruma bakmayın,

Tekrar teşekkür ederim, saygılarımla.

ben dosyayı güncellemiştim

dosyada 2 adet yedekle düğmesi vardı.

 

[1Al2Ver]

ben dosyayı güncellemiştim

dosyada 2 adet yedekle düğmesi vardı.

Sayın halit3 merhaba,

Güncellenmiş dosyayı kullanıyorum, elinize sağlık, tekrar teşekkür ederim.

Saygılarımla.

 

[halit3]

iyi çalışmalar