Çalışma Kitabını Farklı Kaydetme Hk.

[bulentkars]

Arkadaşlar Merhaba

1.Xls Çalışma Kitabım Var.Bu çalışma kitabında düğmeye bastığımda 1.XLS çalışma kitabını C:\YEDEK\ Klasörünün içine 20 kopyasını kopyalasın kitap isimleride 1.xls,2.xls,3.xls,4.xls 20.xls ye kadar çoğaltmak mümkünmü acaba.Eğer C:\YEDEK\Klasörünün altında aynı isimden varsa üzerine yazacak.Bu konuda yardımcı olursanız sevinirim.Şimdiden Teşkkürler.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub FARKLI_KAYDET_20_KOPYA()
    Dim FSO As Object, DOSYA_YOLU As String, DOSYA_ADI As String, X As Byte
 
    DOSYA_YOLU = "C:\YEDEK"
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
 
    If Not FSO.FolderExists(DOSYA_YOLU) Then
        FSO.CreateFolder (DOSYA_YOLU)
    End If
 
    Application.ScreenUpdating = False
 
    For X = 1 To 20
 
    DOSYA_ADI = X & ".xls"
 
    Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=DOSYA_YOLU & "\" & DOSYA_ADI, FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    Application.DisplayAlerts = True
 
    Next
    
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[janveljan]

Bu kodları bir modüle yapıştırıp denerseniz işinize yarayabilir.

Sub kopyala()
    Application.DisplayAlerts = False
    For i = 1 To 20
        ad = "C:\YEDEK\" & i & ".xls"
        ActiveWorkbook.SaveAs Filename:=ad
    Next
End Sub

 

[bulentkars]

Korhan Bey

İlginiz ve değerli zamanınızı ayırdığınız için Çok Teşekkür ederim.
Hayırlı Geceler.

 

[bulentkars]

Sayın Janveljan Çok teşekkür ederim.