I have a functional code, however it now requires one more criteria. I need to check at the beginning of this code to determine if cell I1 (on "Main", codename sheet2) is populated. This cell contains a date that is used in the renaming of the sheet tabs s well as the actual workbook. If I1 is blank, I need the macro to display a message box stating "Please enter the Payroll Date into cellI1", and the code should be exited. Now if cell I1 contains a date, then the macro should run.
Code
Sub Save_Seperate_Sheets()
' Saves multiple sheets in another workbook based on the cell values
Dim fName As String ' Output File Name
Dim Path1 As String ' Path name (current directory)
Dim xlD As Workbook ' Output file
Dim xlS As Workbook ' THIS workbook
Dim shS As Worksheet ' Worksheets in current workbook
' Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Path1 = ThisWorkbook.Path
fName = Sheets("Main").Range("$C$4") & " " & Format(Sheets("Main").Range("$I$1"), "mm.dd.yy") & ".xlsx"
Set xlS = ThisWorkbook
' Rename sheets
Call RenameSheets
' Create the new workbook
Set xlD = Workbooks.Add
' Copy sheets in
For Each shS In xlS.Sheets
If shS.Name <> "Main" Then
shS.Copy after:=xlD.Sheets(Sheets.Count)
xlD.Sheets(Sheets.Count).Name = shS.Name
End If
Next shS
' Remove the superfluous sheets
xlD.Sheets(1).Delete ' <!-- Removes sheet1 (Main)
' Hide the code sheet
xlD.Sheets("codes").Visible = xlHidden
' Save the workbook
xlD.SaveAs FileName:=Path1 & "\" & fName, FileFormat:=51
' Rename Sheet3 & Sheet4 back to default
' Call the RenameSheetsReset macro
Call RenameSheetsReset
'Close the workbook
xlD.save
ResetSettings:
' Reset Macro Optimization Settings
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
xlS.Close True ' <!--- ' THIS workbook
End Sub
Display More