"Yedekle" macrosuna ilave kod

[1Al2Ver]

Merhabalar, Yedekle Düğmesi tıklandığında "Liste" sayfası C2 hücresindeki veriye göre isimlendirerek yedeklemesini arzulamaktayım, aşağıdaki kod'un işlevine nasıl bir ilave yapılmalıdır ?

Örnek ; "Liste" sayfası C2 hücresinde "Ali ODYAKMAZ" yazmakta, düğme tıklandığında "c:\teklifsayfasıyedek.xls" dosyası yerine , c:\teklif\Ali ODYAKMAZ olarak yazmalı, her seferinde düğme tıklandığında "Liste" sayfası C2 hücresine bakmalı ve yedeklemeyi bu mantığa göre yapmalı, şayet daha önce C2'de böyle bir kayıt var ise uyarmalı ve "evet yada hayır" cevabına göre işleme izin vermeli, emeklerinize teşekkür ederim.

Sub yedekle()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("teklif").Copy
ActiveWorkbook.SaveAs "c:\teklifsayfasıyedek.xls"
ActiveWorkbook.Close True
MsgBox "Teklif Sayfası Yedeklenmiştir.", 32, "Sonuç !"
End Sub

 

[Ayhan Ercan]

Dim ad As String
ad = Sheets("liste").Range("c2")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("teklif").Copy
ActiveWorkbook.SaveAs "c:\teklif\" & ad & ".xls"
ActiveWorkbook.Close True
MsgBox "Teklif Sayfası Yedeklenmiştir.", 32, "Sonuç !"

 

[1Al2Ver]

Dim ad As String
ad = Sheets("liste").Range("c2")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("teklif").Copy
ActiveWorkbook.SaveAs "c:\teklif\" & ad & ".xls"
ActiveWorkbook.Close True
MsgBox "Teklif Sayfası Yedeklenmiştir.", 32, "Sonuç !"

Sayın Ayhan Ercan, öncelikle cevap için içtenlikle teşekkür ederim, birazdan uygulamaya alacağım, izninizle bir şey sormak istiyorum, aynı kayıttan daha önce var ise "uyarı" mesajı alabilirmiyim, teşekkür ederim.

 

[Ayhan Ercan]

özür dilerim sorunuzu tam okumadan cevap vermişim. ikinci sorunuza baktım. bunu yapamadım üzgünüm. uzman arkadaşlarımız yardım edeceklerdir.

 

[1Al2Ver]

özür dilerim sorunuzu tam okumadan cevap vermişim. ikinci sorunuza baktım. bunu yapamadım üzgünüm. uzman arkadaşlarımız yardım edeceklerdir.

Rica ederim sayın Ercan, ben teşekkür ederim, Kod tek sayfa kopyalıyor, ikinci kez istendiğinde de üzerine kopyalıyor, kopyaladığı isim C2 hücresinin aynısı değil, bunları kod uygulanınca çıkan sonuçlar olarak ve bilgi amaçlı yazdım, ilginiz için tekrar tekrar teşekkür ederim, saygılarımla.

 

[1Al2Ver]

İyi sabahlar dilerim, sanırım sitede 4 mesaj görülünce cevap gelmedi, çözüm bekleyen bu macroya ilave edilecek kodu alabilirsem memnun olurum, teşekkür ederim.

 

[1Al2Ver]

Merhabalar, Yedekle Düğmesi tıklandığında "Liste" sayfası C2 hücresindeki veriye göre isimlendirerek yedeklemesini arzulamaktayım, aşağıdaki kod'un işlevine nasıl bir ilave yapılmalıdır ?

Örnek ; "Liste" sayfası C2 hücresinde "Ali ODYAKMAZ" yazmakta, düğme tıklandığında "c:\teklifsayfasıyedek.xls" dosyası yerine , c:\teklif\Ali ODYAKMAZ olarak yazmalı, her seferinde düğme tıklandığında "Liste" sayfası C2 hücresine bakmalı ve yedeklemeyi bu mantığa göre yapmalı, şayet daha önce C2'de böyle bir kayıt var ise uyarmalı ve "evet yada hayır" cevabına göre işleme izin vermeli, emeklerinize teşekkür ederim.

Sub yedekle()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("teklif").Copy
ActiveWorkbook.SaveAs "c:\teklifsayfasıyedek.xls"
ActiveWorkbook.Close True
MsgBox "Teklif Sayfası Yedeklenmiştir.", 32, "Sonuç !"
End Sub

Yardım talebim devam etmektedir, saygılarımla.

 

[yst10]

Selamlar,
Bu konu beni de ilgilendiriyor,
yardımcı olacak ustalara şimdiden teşekkürler. 1Al2Ver in yardım talebine gönülden katılıyorum.
Ayrıca, kendisine de teşekkürler.
Yavuz Tümer

 

[1Al2Ver]

Selamlar,
Bu konu beni de ilgilendiriyor,
yardımcı olacak ustalara şimdiden teşekkürler. 1Al2Ver in yardım talebine gönülden katılıyorum.
Ayrıca, kendisine de teşekkürler.
Yavuz Tümer

Sayın yst10, nezaketiniz için teşekkür ederim, talebimize kısa zamanda cevap ve çözüm gelir, bu ara ustalarımız biraz yoğunlar, tekrar teşekkürler.

 

[Zeki Gürsoy]

Biraz uzunca oldu, idare edin.

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

[COLOR=DarkGreen]'// Yeni çalışma kitabı aç..[/COLOR]
Set wb = Workbooks.Add

[COLOR=DarkGreen]'// Silinmek üzere sayfalar isimlenir..[/COLOR]
For i = 1 To Sheets.Count
    wb.Sheets(i).Name = i
Next

[COLOR=DarkGreen]'// Yeni kitaba "teklif" sayfasnı kopyala..[/COLOR]
ThisWorkbook.Sheets("teklif").Copy _
    Before:=Workbooks("" & wb.Name).Sheets(1)
   
[COLOR=DarkGreen]'// İsimlendirdiğimiz sayfaları sil..[/COLOR]
Application.DisplayAlerts = False
For i = 1 To wb.Sheets.Count - 1
    wb.Sheets("" & i).Delete
Next

[COLOR=DarkGreen]'// Dizin yoksa oluştur..[/COLOR]
On Error Resume Next
MkDir "C:\teklif\"

On Error GoTo 0
With ThisWorkbook.Sheets("Liste").[c2]
[COLOR=DarkGreen]'// Kaydedilecek dosya mevcutsa sor, varsa sil veya çık ya da kaydet..[/COLOR]
    If Dir("C:\teklif\" & .Value & ".xls") <> "" Then
            sor = MsgBox("'C:\teklif\" & .Value & ".xls" & _
            "' mevcuttur! Üzerine yazılsın mı?", vbYesNo + vbExclamation)
            
        If sor = vbYes Then
            Kill "C:\teklif\" & .Value & ".xls"
        Else
            Exit Sub
        End If
    End If
    
    wb.SaveAs "C:\teklif\" & .Value & ".xls"
    wb.Close False
    
End With

Application.DisplayAlerts = True

End Sub

 

[1Al2Ver]

Sayın Zeki Gürsoy, elinize sağlık, teşekkür ederim, saygılarımla.

 

[yst10]

Sn. Zeki Bey,
Çok teşekkür ederim, ellerinize sağlık. Saygılar.
Yavuz Tümer