Çoklu kaydetme sorunu

[yNsr43]

selam üstadlar, şöyle bir kod yazmaya çaliştim (daha doğrusu birleştirmeye çaliştim ) ama çalişmiyor yardim ederseniz sevinirim.
şimdiden teşekkürler.

Sub coklukaydet)
Dim i As Long
Dim Yol As String, Adres As String
Dim Nesne, Klasor, Dosya

Yol = "C:\Users\Panda\Desktop\Dönem4 Ekler\deneme\kaynak"

Set Nesne = CreateObject("Scripting.FileSystemObject")
Set Klasor = Nesne.getfolder(Yol)

i = 1
For Each Dosya In Klasor.Files
Adres = "'" & Yol & "\[" & Dosya.Name & "]Sayfa1'!"

    Range("A2") = ActiveSheet.Name
    
    ActiveSheet.Name = "Genel"
    Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:\Users\Panda\Desktop\excel çalişma\Yeni klasör\yedek" & [a2].Value
        xlOpenXMLWorkbook , CreateBackup:=False
        Application.DisplayAlerts = False
ActiveWorkbook.Close
i = i + 1
Next Dosya
End Sub

 

[Necdet]

Merhaba,

Kodlardan ziyade ne yapmak istediğinizi söyleyin. Kodları inceleyip anlayacak kişilerin zamanı var mıdır yok mudur bilemezsiniz.

 

[yNsr43]

pardon hocam haklısınız.
bir klsörde xls dosyaları var buradaki dosyaları belirlediğim şablonda açıp, A4 hücresindeki isimle birlikte "xlsm" olarak farkli kaydetmesini istiyordum.
teşekkürler.

http://s3.dosya.tc/server11/jj3yjy/sablon.rar.html