Dosyayı Masaüstüne hücre ismiyle kaydetme

[ismail-34]

Çok Değerli Excel web hocalarına selamlar saygılar.

Benim sorum veri sekmesindeki c2 hücresindeki tarihin alınarak excel dosyasının masaüstüne bu isimle makro olarak kaydedilmesi ile ilgili olacak.

ornegin c2= 09.06.2023 ise dosya masaüstüne 09-06-2023.xlsm olarak kaydedilsin.

örnek ektedir..

Herkese şimdiden iyi bayramlar dilerim..

 

[tahsinanarat]

Bu şekilde işinizi görürmü?

Option Explicit

Sub Yedekle()
Dim Yol As String, Sayfa As Worksheet

Yol = "c:\Yedek"
If Dir(Yol, vbDirectory) = "" Then MkDir (Yol)

If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo + vbDefaultButton2) = vbNo Then
MsgBox "İşlemi iptal ettiniz!", vbExclamation
Exit Sub
End If

ThisWorkbook.Save
ThisWorkbook.SaveCopyAs Yol & "\" & Range("C2") & ".xlsm"

MsgBox "Dosya c:\Yedek klasörüne yedeklendi.", vbInformation
End Sub

 

[ismail-34]

Tesekkurler tahsin bey cok isime yaradi.

 

[RBozkurt]

7. mesaja bakınız.

Deneyiniz, kod aynı yol güncellendi.

Option Explicit

Sub Yedekle()
    Dim Yol As String, Sayfa As Worksheet

    Yol = Environ("username") & "\Desktop"
    If Dir(Yol, vbDirectory) = "" Then MkDir (Yol)

    If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo + vbDefaultButton2) = vbNo Then
        MsgBox "İşlemi iptal ettiniz!", vbExclamation
        Exit Sub
    End If

    ThisWorkbook.Save
    ThisWorkbook.SaveCopyAs Yol & "\" & Range("C2") & ".xlsm"

    MsgBox "Dosya " & Yol & " klasörüne yedeklendi.", vbInformation
End Sub

 

[ismail-34]

Deneyiniz, kod aynı yol güncellendi.

Option Explicit

Sub Yedekle()
    Dim Yol As String, Sayfa As Worksheet

    Yol = Environ("username") & "\Desktop"
    If Dir(Yol, vbDirectory) = "" Then MkDir (Yol)

    If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo + vbDefaultButton2) = vbNo Then
        MsgBox "İşlemi iptal ettiniz!", vbExclamation
        Exit Sub
    End If

    ThisWorkbook.Save
    ThisWorkbook.SaveCopyAs Yol & "\" & Range("C2") & ".xlsm"

    MsgBox "Dosya " & Yol & " klasörüne yedeklendi.", vbInformation
End Sub

teşekkürler desktop kayıt yolunuda öğrenmiş olduk .

 

[hakki83]

Deneyiniz, kod aynı yol güncellendi.

Option Explicit

Sub Yedekle()
    Dim Yol As String, Sayfa As Worksheet

    Yol = Environ("username") & "\Desktop"
    If Dir(Yol, vbDirectory) = "" Then MkDir (Yol)

    If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo + vbDefaultButton2) = vbNo Then
        MsgBox "İşlemi iptal ettiniz!", vbExclamation
        Exit Sub
    End If

    ThisWorkbook.Save
    ThisWorkbook.SaveCopyAs Yol & "\" & Range("C2") & ".xlsm"

    MsgBox "Dosya " & Yol & " klasörüne yedeklendi.", vbInformation
End Sub

RBozkurt hocamız merhaba,
Kod hata veriyor, bir eksiklik olabilir mi acaba?

 

[tahsinanarat]

Masa üstüne kayıt için aşağıdaki kodu deneyiniz

Option Explicit

Sub Yedekle()
Dim Yol As String, Sayfa As Worksheet

Yol = "C:\Users\" & Environ$("UserName") & "\Desktop\Yedek"
If Dir(Yol, vbDirectory) = "" Then MkDir (Yol)

If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo + vbDefaultButton2) = vbNo Then
MsgBox "İşlemi iptal ettiniz!", vbExclamation
Exit Sub
End If

ThisWorkbook.Save
ThisWorkbook.SaveCopyAs Yol & "\" & Range("C2") & ".xlsm"

MsgBox "Dosya Masaüstündeki Yedek klasörüne yedeklendi.", vbInformation
End Sub