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.
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
Any assistance will be greatly appreciated.