Excel userform vba add and save worksheet

C.A.M · Dec 5th 2019

Hello. I'm not exactly an expert in Excel VB by any means, 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 relating to taxes is produced and stored on a worksheet named "Data" for fiscal quarters 1 to 4. My idea is that the data in every quarter can be archived in separate worksheets and saved 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 other web sites and threads.

Below is what i have got so far.

Code

Sub SaveAndExport()
    Dim ans As Long
    Dim MyPath As String
    Dim MyFileName As String
    Dim wks As Worksheet: Set wks = Worksheets("Data")
    Dim WB1 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 = wks.Range("A" & Rows.Count).End(xlUp).CurrentRegion
        Application.ScreenUpdating = False
        rng.Copy
        Application.DisplayAlerts = False
        Dim WB2 As Workbook
        Set WB2 = Application.Workbooks.Add
        Dim wks2 As Sheets: Set wks2 = WB2.Sheets
        Dim obj As Object
        Set obj = wks2.Add(Before:=ActiveSheet, Count:=1, Type:=XlSheetType.xlWorksheet)
        obj.Name = wks.Range("T7")
        ActiveWorkbook.ActiveSheet.Range("A1").PasteSpecial xlPasteValues
        ActiveWorkbook.ActiveSheet.Range("A:K").PasteSpecial xlPasteFormats
        ActiveWorkbook.ActiveSheet.Range("A:K").PasteSpecial xlPasteColumnWidths
        ActiveWorkbook.ActiveSheet.Range("L1").Select
        MyFileName = "RaysTax" & " " & wks.Range("S25")
        MyPath = WB1.Path & "\" & MyFileName
        MsgBox MyPath
        If MsgBox("Data copied to " & WB1.Path & "\" & MyFileName & vbCrLf & vbCrLf & _
                  "Warning: Files in directory with same name will be overwritten!!", vbCritical + vbYesNo) <> vbYes Then
            Exit Sub
        End If
        If Not Right(MyFileName, 4) = ".xls" Then
            MyFileName = MyFileName & ".xls"
        End If
        With WB2
            .SaveAs Filename:=MyFileName, FileFormat:=56, CreateBackup:=False
            .Close False
        End With
        ' ws.Range("A2:L1000").Clear
        MsgBox MyFileName & " Data has been saved.", vbInformation
        Application.DisplayAlerts = True
        UserForm1.MultiPage1.Pages(0).Enabled = True
        UserForm1.MultiPage1.Pages(1).Enabled = True
        UserForm1.MultiPage1.Value = 0
        cmdArchiveQ.BackColor = RGB(0, 128, 0)
    End If
End Sub

Display More

Any assistance will be greatly appreciated.

**royUK** · Dec 5th 2019

It's much more efficient to keep the data in one workbook, then build a report to provide data for a chosen quarter. It's also more secure, especially with tax data, to maintain one workbbook, there's less chance of missing changes made in the master workbook.

Provide an example workbook with some dummy data and I'll take a look.

**royUK** · Dec 5th 2019

I've just looked through your code and it needs a lot of tidying up.
You appear to use PasteSpecial without copying anything.

If you really want to create a new workbook then it looks like you are simply copying the completed data to another workbook. Are there formulas in the data to be removed?

I would simply copy that data sheet to a new workbook
Rename the workbook and save it.
Next, clear the data from the existing sheet.

The above way would reduce the amount of code and be more efficient

**royUK** · Dec 5th 2019

I've just looked through your code and it needs a lot of tidying up.
You appear to use PasteSpecial without copying anything.

If you really want to create a new workbook then it looks like you are simply copying the completed data to another workbook.

I would simply copy that data sheet to a new workbook
Rename the workbook and save it.
Next, clear the data from the existing sheet.

Are there formulas in the data to be removed?

**royUK** · Dec 5th 2019

This is my attempt to tidy up your existing code with comments

Code

Sub SaveAndExport()
''/// all variable should be declared here
    Dim ans As Long
    Dim MyPath As String
    Dim MyFileName As String
    Dim WB1 As Workbook, WB2 As Workbook
    Dim wks As Worksheet, wks2 As Worksheet
    Dim rngPrint As Range, rng As Range
      Dim obj As Object

    Set WB1 = ActiveWorkbook
    Set wks = Worksheets("Data")

    ans = MsgBox("Are you sure you want to archive the current data?", vbQuestion + vbYesNo, "WARNING")
    If ans = vbYes Then
        ''///  wks.Range("A" & Rows.Count).End(xlUp).CurrentRegion -> you do not need to find the last row with CurrentRegion
        Set rng = wks.Range("A").CurrentRegion
        Application.ScreenUpdating = False
        rng.Copy
        Application.DisplayAlerts = False
        Set WB2 = Application.Workbooks.Add
        Set wks2 = WB2.Sheets
     ''/// what is this for?
        '        Set obj = wks2.Add(Before:=ActiveSheet, Count:=1, Type:=XlSheetType.xlWorksheet)
        '        obj.Name = wks.Range("T7")
        ActiveSheet.Range("A1").CurrentRegion.Copy
        ActiveSheet.Range("A1").PasteSpecial xlAll

        MyFileName = "RaysTax" & " " & wks.Range("S25")
        MyPath = WB1.Path & "\" & MyFileName
        '        MsgBox MyPath
        If MsgBox("Data copied to " & WB1.Path & "\" & MyFileName & vbCrLf & vbCrLf & _
                  "Warning: Files in directory with same name will be overwritten!!", vbCritical + vbYesNo) <> vbYes Then
            Exit Sub
        End If
        If Not Right(MyFileName, 4) = ".xlsx" Then
            MyFileName = MyFileName & ".xlsx"
        End If
        With WB2
            .SaveAs Filename:=MyFileName, FileFormat:=56, CreateBackup:=False
            '            .Close False ''/// this will close without saving!
            .Close True
        End With
        ' ws.Range("A2:L1000").Clear
        MsgBox MyFileName & " Data has been saved.", vbInformation
        Application.DisplayAlerts = True
        With UserForm1
            .MultiPage1.Pages(0).Enabled = True
            .MultiPage1.Pages(1).Enabled = True
            .MultiPage1.Value = 0
            .cmdArchiveQ.BackColor = RGB(0, 128, 0)
        End With

    End If
End Sub

Display More

C.A.M · Dec 6th 2019

Hello RoyUK.

Thankyou for your quick response.

I have attached my program for you to look over. My step brother asked me if i could help him out and thus far, well you'll see when you open it. I'm trying to make it as simple as possible for him to use, plus it's a good learning curve.

If possible, can you look through it and let me know what other mistakes i have made and adjustments reqired?

Excel userform vba add and save worksheet

Participate now!

Share

Tags