Excel vba add and save worksheet RRS feed

  • Question

  • Hello. I'm not exactly an expert in Excel VB, but any assistance would be welcome. I really don't know how to go about this part.

    I have created a userform, from which data is produced and stored on a worksheet named "Data" for yearly fiscal quarters.  My idea is that the data every quarter can be archived into another workbook for that specific fiscal year, then at the end of that year another workbook can be created for which that fiscal years fiscal quarters worksheets can be archived and so on.

    I've created some code for the archive function, but i don't know how to add on to it. Most of the code was was from web sites.  

    below is what i have got so far.


    Public Sub SaveAndExport()
        Dim ans As Long
        Dim MyPath As String
        Dim MyFileName As String
        Dim inc As String
        Dim ws As Worksheet
        Set ws = Worksheets("Data")
        Dim WB1 As Workbook, WB2 As Workbook
        Dim rngPrint As Range
        Set WB1 = ActiveWorkbook
        ans = MsgBox("Are you sure you want to archive the current data?", vbQuestion + vbYesNo, "WARNING")
        If ans = vbYes Then
            Dim rng As Range
            Set rng = ws.Range("A" & Rows.Count).End(xlUp).CurrentRegion
            Application.ScreenUpdating = False

            Set WB2 = Application.Workbooks.Add(1)
            WB2.Sheets(1).Range("A1").PasteSpecial xlPasteValues
            MyFileName = (Me.lblFiscalQuarter.Caption)
            MyPath = WB1.Path & "\" & "RaysTax"

            Application.DisplayAlerts = False
            If MsgBox("Data copied to " & WB1.Path & "\" & MyFileName & vbCrLf & _
                "Warning: Files in directory with same name will be overwritten!!", vbCritical + vbYesNo) <> vbYes Then
                Exit Sub
            End If
            If MsgBox("Do you want to print before file closes?", _
                vbYesNo + vbQuestion, "Do You Want to Print?") = vbYes Then
                Set rngPrint = rng
            End If
            If Not Right(MyFileName, 4) = ".csv" Then
                MyFileName = MyFileName & ".csv"
                With WB2
                    .SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False
                    .Close False
                End With
            End If
    '        ws.Range("A2:L1000").Clear
            MsgBox MyFileName & "Data has been saved."
            Application.DisplayAlerts = True
            UserForm1.MultiPage1.Pages(0).Enabled = True
            UserForm1.MultiPage1.Pages(1).Enabled = True
            UserForm1.MultiPage1.Value = 0
        End If
    End Sub

    I appreciate your assistance.

    Friday, November 15, 2019 8:32 AM