Soru VBA da Sadece Çalışma Sayfasını Farklı Kaydet

[burakalsancak]

Merhaba,

Elimde bir VBA kodu var. Hücreye bağlı olarak dosya ismi ile farklı kaydet yapıyor. Bu kod excel dosyasının tamamını kaydediyor. Sadece bir çalışma sayfasını kaydedecek şekilde düzenlenebilir mi ? (Sheet1)

Sub Makro1()
'
' Makro1 Makro
'

'
On Error Resume Next
Dim iResponse As Integer
    iResponse = MsgBox("Dosya (" & Range("D7") & ") adı ile kaydedilecektir, Onaylıyor musunuz ?  ", vbYesNo, "Farklı Kaydet")
    'check to see if cancel button selected
    If iResponse = vbNo Then
        
    End If
    If iResponse = vbYes Then
    
    
        ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\060368\Documents\" & Range("D7") & ".xlsm" _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        
        MsgBox ("Dosya " & Range("D7") & " adı ile ilgili klasöre kaydedilmiştir.  ")
        '
'

'
    On Error GoTo 0
    End If

End Sub

 

[veyselemre]

Sub test()

    If MsgBox("Dosya (" & Range("D7") & ") adı ile kaydedilecektir, Onaylıyor musunuz ?  ", vbYesNo, "Farklı Kaydet") = vbYes Then
        Set wb = ActiveWorkbook
        Sheets("Sheet1").Copy
        ActiveWorkbook.SaveAs Filename:= _
                              "C:\Users\060368\Documents\" & Range("D7") & ".xlsm" _
                              , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        ActiveWorkbook.Close
        wb.Activate
        MsgBox ("Dosya " & Range("D7") & " adı ile ilgili klasöre kaydedilmiştir.  ")
    End If

End Sub

 

[burakalsancak]

Sub test()

    If MsgBox("Dosya (" & Range("D7") & ") adı ile kaydedilecektir, Onaylıyor musunuz ?  ", vbYesNo, "Farklı Kaydet") = vbYes Then
        Set wb = ActiveWorkbook
        Sheets("Sheet1").Copy
        ActiveWorkbook.SaveAs Filename:= _
                              "C:\Users\060368\Documents\" & Range("D7") & ".xlsm" _
                              , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        ActiveWorkbook.Close
        wb.Activate
        MsgBox ("Dosya " & Range("D7") & " adı ile ilgili klasöre kaydedilmiştir.  ")
    End If

End Sub

Merhaba,

İlginiz için teşekkür ederim. Kodu denedim, fakat şöyle bir durum var. Makro çalıştığında öncesinde sadece uyarı kodu geliyordu, kaydetme ekranı hiç görünmeden kaydedilmiştir yazıyordu ve dosya kaydedilmiş oluyordu. Şimdi ilettiğiniz kod ile, ilgili sayfayı farklı bir excel çalışma kitabı olarak ekrana açıyor ve kaydedilecek yeri, ismi soran farklı kaydet penceresi açılıyor.

 

[veyselemre]

Range("D7") ile belirtmiş olduğunuz isim Sheet1 de değilse hata vermesi normal. Aşağıdaki gibi deneyin.

Sub test()
    fName=Range("D7")
    If MsgBox("Dosya (" & fName & ") adı ile kaydedilecektir, Onaylıyor musunuz ?  ", vbYesNo, "Farklı Kaydet") = vbYes Then
        Set wb = ActiveWorkbook
        Sheets("Sheet1").Copy
        ActiveWorkbook.SaveAs Filename:= _
                              "C:\Users\060368\Documents\" & fName & ".xlsm" _
                              , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        ActiveWorkbook.Close
        wb.Activate
        MsgBox ("Dosya " & Range("D7") & " adı ile ilgili klasöre kaydedilmiştir.  ")
    End If

End Sub