Πέμπτη, 18 Απριλίου, 2024
More
    ΑρχικήMicrosoft ExcelΑποθήκευση των tabs σε διαφορετικό path με Macro

    Αποθήκευση των tabs σε διαφορετικό path με Macro

    Οι καρτέλες αποθηκεύονται ως αυτοτελή excel. Οι τιμές των κελιών τους αποθηκεύονται ως values.

     

    Option Explicit
    
    Public Sub MISCSV()
    
    Dim wbkExport As Workbook
    Dim shtToExport As Worksheet
    
    Set shtToExport = ThisWorkbook.Worksheets("mis")
    Set wbkExport = Application.Workbooks.Add
    shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
    Application.DisplayAlerts = False
    Worksheets("mis").Cells.Copy
    Worksheets("mis").Cells.PasteSpecial xlPasteValues
    wbkExport.SaveAs Filename:="C:\MIS\mis.xlsx"
    Application.DisplayAlerts = True
    wbkExport.Close SaveChanges:=False
    
    Set shtToExport = ThisWorkbook.Worksheets("PORTFOLIO STATISTICS")
    Set wbkExport = Application.Workbooks.Add
    shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
    Application.DisplayAlerts = False
    Worksheets("Portfolio Statistics").Cells.Copy
    Worksheets("Portfolio Statistics").Cells.PasteSpecial xlPasteValues
    wbkExport.SaveAs Filename:="C:\mis\PORTFOLIO STATISTICS.xlsx"
    Application.DisplayAlerts = True
    wbkExport.Close SaveChanges:=False
    
    Set shtToExport = ThisWorkbook.Worksheets("DAILY REVAL")
    Set wbkExport = Application.Workbooks.Add
    shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
    Application.DisplayAlerts = False
    Worksheets("daily reval").Cells.Copy
    Worksheets("daily reval").Cells.PasteSpecial xlPasteValues
    wbkExport.SaveAs Filename:="C:\mis\DAILY REVAL.xlsx"
    Application.DisplayAlerts = True
    wbkExport.Close SaveChanges:=False
    
    Set shtToExport = ThisWorkbook.Worksheets("PORTFOLIO BENCHMARK")
    Set wbkExport = Application.Workbooks.Add
    shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
    Application.DisplayAlerts = False
    Worksheets("PORTFOLIO BENCHMARK").Cells.Copy
    Worksheets("PORTFOLIO BENCHMARK").Cells.PasteSpecial xlPasteValues
    wbkExport.SaveAs Filename:="C:\mis\PORTFOLIO BENCHMARK.xlsx"
    Application.DisplayAlerts = True
    wbkExport.Close SaveChanges:=False
    
    Set shtToExport = ThisWorkbook.Worksheets("SYNOLA")
    Set wbkExport = Application.Workbooks.Add
    shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
    Application.DisplayAlerts = False
    Worksheets("SYNOLA").Cells.Copy
    Worksheets("SYNOLA").Cells.PasteSpecial xlPasteValues
    wbkExport.SaveAs Filename:="C:\mis\SYNOLA.xlsx"
    Application.DisplayAlerts = True
    wbkExport.Close SaveChanges:=False
    
    
    MsgBox "ALL DONE"
    End Sub
    Θεόδωρος Τασσόπουλος
    Θεόδωρος Τασσόπουλοςhttps://www.digispot.gr
    Τεχνολόγος Ηλεκτρονικός Μηχανικός MSc in Networking & Data Communications. MSc in Banking, Accounting and Finance. Ασχολούμαι με τον προγραμματισμό από τις αρχές του 2000. Τα τελευταία πέντε έτη ασχολούμαι με την Διοικητική Πληροφόρηση και το Business Intelligence γενικότερα. Ξεκινάω συνεχώς νέα project χωρίς να υπάρχει απαραίτητα η προοπτική του κέρδους. Λάτρης των θετικών επιστημών και θαυμαστής αυτών που τις αντιλαμβάνονται.
    RELATED ARTICLES