Çözüldü Masaüstüne Dosya Kaydetmek

[cavanoos]

Merhaba;

Aşağıdaki kod ile daha önce txt dosyayı kaydediyordum.
Şimdi excel kaydedeceğim. Dosyayı masaüstüne kaydediyor ama açarken dosya biçimi hatası veriyor, dosya açılmıyor.
Aynı amaca uygun farklı bir kod yapısı da olur.
Yardım edebilir misiniz ?

Dim desktopPath$, myFile$, i, lRow, dataObj
Set dataObj = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
myFile = desktopPath & "\Aktif.xlsx"
lRow = Intersect(Range("A:AZ"), ActiveSheet.UsedRange).Rows.Count
Range("A1:AZ" & lRow).Copy
Open myFile For Output As #1
dataObj.GetFromClipboard
Print #1, dataObj.GetText
Close #1
Application.CutCopyMode = False

 

[EmrExcel16]

Merhaba deneyiniz..

Sub Farkli_Kaydet()

    Dim DsyYol, Dsy

    On Error Resume Next

    ActiveSheet.Copy

    DsyYol = CreateObject("WScript.Shell").SpecialFolders("Desktop") + "\"

    Dsy = ActiveSheet.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")     

    ActiveWorkbook.SaveAs DsyYol & Dsy       

    ActiveWorkbook.Close SaveChanges:=False 

End Sub

 

[cavanoos]

Teşekkür ederim, oldu

 

[EmrExcel16]

Teşekkür ederim, oldu

Rica ederim, iyi çalışmalar..