Sayfa Kopyala Dosya Olarak Kaydet

[Metin55]

İyi günler;
Ekteki örnek dosda 5 adet sayfa bulunmaktadır.Benim yapmak istediğim bu 5 sayfadan A sayfasındaki verilen B sayfasına kopyalanması ve a sayfasında C5 hücresine dosyanın ismini yazdığımda o isimle A,B,C sayfalarının alınarak C5 hücresine girilen isimle dosyanın D klasörü içerisinde İSİMLER klasörünün çerisine kayıt yapılması dır.Kayıt yapılırken Nolu dosyayı kaydetmek istiyormusunuz ,Nolu dosya kayıt yapıldı uyarısı verebilir mi?

 

[Metin1981]

İyi günler;
Arkadaşlar 1.nolu mesajımdaki dosyaya yardım edebilirmisiniz?

 

[Metin1981]

Arkadaşlar acil olarak yardıma ihtiyacım var

 

[Metin55]

Arkadaşlar konuya desteğinizi bekliyorum

 

[hamitcan]

Bu şekilde deneyin.

Sub VerileriAktar()
    Sheets("A").Range("F9:F14").Copy
    s = Sheets("B").[d65536].End(3).Row + 1
    Cells(s, "d").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
        MsgBox "Bilgiler Aktarıldı."
End Sub
Sub FarkliKaydet()
    MyPath = ThisWorkbook.Path
    Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs _
        Filename:=MyPath & "\" & Sheets("A").[c5] & ".xls"
        Sheets("D").Delete
        Sheets("E").Delete
    Application.DisplayAlerts = True
    ActiveWorkbook.Save
    MsgBox "Dosya Kaydedildi."
    Workbooks.Open MyPath & "\" & "ÖRNEK.xls"
End Sub

 

[Murat OSMA]

■ Alternatif;

Sub Farklı_Kaydet()
    If MsgBox("Kaydetmek istiyor musunuz ?", vbInformation + vbYesNo, "Soru") = vbNo Then Exit Sub
    Sheets("A").Range("F9:F14").Copy
    Sheets("B").Range("D10").PasteSpecial Paste:=xlPasteAll, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Application.CutCopyMode = False
    Application.DisplayAlerts = False
    Sheets(Array("D", "E")).Delete
    ActiveWorkbook.SaveAs Filename:="D:\İSİMLER\" & Range("C5").Value & ".xls", FileFormat _
    :=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
    False, CreateBackup:=False
    MsgBox "Kaydedildi"
End Sub