Makro ile yedekleme

[serif_007]

arkadaşlar merhaba

bir çalışma kitabım var ve bu çalışma kitabının içindeki sekmelere Makro ile veri çekiyorum ve veriler çekildikten sonra yedeklemek istiyorum kullandığım kod şu

Sub dasyakopyala()
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
veriKlasor = "C:\Users\Şerif\Desktop\şerif vb çalışma\şerif\serifvbcalisma\Açık.xls"""
hedefKlasor = "D:\Çıkış Yedekleri\Aydın\Aydın\" & CStr(Year(Dun)) & "\" & CStr(Month(Dun)) & "\" & CStr(Day(Dun)) & "\Aydın.xls\"
On Error Resume Next
For i = 1 To [a65536].End(3).Row
Dosya = veriKlasor & Cells(i, 1).Value
If CreateObject("Scripting.FileSystemObject").FileExists(Dosya) = True Then
DosyaSistemi.CopyFile Dosya, hedefKlasor & Cells(i, 1).Value
End If
Next i
End Sub

bu kod ile sadece klasör açıyor nerede hata yapıyorum anlamadım yardımcı olurmusunuz?

ben D:\Çıkış Yedekleri\Aydın\Aydın.xls olarak kaydetmesini istiyorum

 

[beyinmuhendisi]

Aşağıdaki kodu uyarlayabilirsin diye düşünüyorum.

Sub Yedek_Al()
ActiveSheet.Copy
    Application.DisplayAlerts = False
    If Dir("D:\Çıkış Yedekleri\Aydın", vbDirectory) = "" Then
             MkDir "D:\Çıkış Yedekleri\Aydın"
    End If
    ActiveWorkbook.SaveAs Filename:="D:\Çıkış Yedekleri\Aydın\Aydın" & Format(Now, " dd_mm_yyyy hh_mm") & " Esit", FileFormat:=xlNormal _
        , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    ActiveWindow.Close
    MsgBox "     Aktif sayfa      D:\Çıkış Yedekleri\Aydın      klasörüne kopyalandı.", vbInformation

End Sub

 

[serif_007]

beyinmuhendi yardımın için teşekkür ederim ama bir sorum daha olacak ben bu çalışma kitabını

D:\Çıkış Yedekleri\Aydın

Aydın İçerisinde Yıl klasörü Yıl Klasörü İçerisine Ay klasörü Ay klasörü içerisine de Gün Klasörü olarak kaydetmesini istiyorum yani her gün makroyu çalıştırdığımda örnek veriyorum

D:\Çıkış Yedekleri\Aydın\2014\NİSAN\23
D:\Çıkış Yedekleri\Aydın\2014\NİSAN\24
D:\Çıkış Yedekleri\Aydın\2014\NİSAN\25
D:\Çıkış Yedekleri\Aydın\2014\NİSAN\26

olarak kaydetmesini istiyorum bunun için kodda nasıl bir değişiklik yapmam gerekli

 

[beyinmuhendisi]

Birkaç gündür giremiyordum. Şimdi biraz uğraştım ama kırmızı xxx ile gösterdiğim yeri bir türlü beceremedim. Ustalardan yardım alman gerekecek. Kusura bakma.

Sub Yedek_Al()
ActiveSheet.Copy
tarih = Format(Now, " dd_mm_yyyy")
    Application.DisplayAlerts = False
    If Dir("D:\Çıkış Yedekleri\Aydın", vbDirectory) = "" Then
             MkDir "D:\Çıkış Yedekleri"
             MkDir "D:\Çıkış Yedekleri\Aydın"
             MkDir "D:\Çıkış Yedekleri\Aydın\" & tarih
             
    End If
    ActiveWorkbook.SaveAs Filename:="D:\Çıkış Yedekleri\Aydın\[COLOR="Red"]xxx[/COLOR]" & Format(Now, " dd_mm_yyyy") & "", FileFormat:=xlNormal _
        , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    ActiveWindow.Close
    MsgBox "     Aktif sayfa      D:\Çıkış Yedekleri\Aydın\      klasörüne kopyalandı.", vbInformation

End Sub