Hi,
Can someone please help me to update this code to insert a new sheet before running it, and other needed corrections to run the code with the new sheet.
This is to not having to insert blank sheets before running the code.
TIA[/code]
Can someone please help me to update this code to insert a new sheet before running it, and other needed corrections to run the code with the new sheet.
This is to not having to insert blank sheets before running the code.
Code:
Sub NewWeek_Click()
'CompanyIncomeStatsGrid
Application.ScreenUpdating = False
'1) Verify procedure before continue msg box
Prompt = "Are you certain that you want to continue and install a new worksheet for a new week? The new Sheet will be based upon the old sheet and the old sheet must be complete before you continue. The new sheet will NOT update its values if you later change earlier sheet. You must then change all sheets that follows the earlier one you change."
Title = "Verify Procedure"
Proceed = MsgBox(Prompt, vbYesNo + vbQuestion, Title)
If Proceed = vbNo Then
MsgBox "Procedure Canceled", vbInformation, "Procedure Aborted"
Exit Sub
End If
'2) Move the sheet to a new week
ActiveSheet.Unprotect
Sheets(ActiveSheet.Index + 1).Unprotect
Range("a4", Cells.SpecialCells(xlCellTypeLastCell).Address).EntireRow. _
Copy Destination:=Sheets(ActiveSheet.Index + 1).Range("a1")
Range("a4", Cells.SpecialCells(xlCellTypeLastCell).Address).EntireColumn. _
Copy Destination:=Sheets(ActiveSheet.Index + 1).Range("a1")
CutCopyMode = False
Range("a1").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
Sheets(ActiveSheet.Index + 1).Select
Range("a1").Select
'3) Update the sheet for a new week:
Range("C4:J4").Select
Selection.Copy
Range("C5").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("C6:J6").Select
Selection.Copy
Range("C7").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("C8:J8").Select
Selection.Copy
Range("C9").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("C10:J10").Select
Selection.Copy
Range("C11").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("C12:J12").Select
Selection.Copy
Range("C13").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("C14:J14").Select
Selection.Copy
Range("C15").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("C4:J4,C6:J6,C8:J8,C10:J10,C12:J12,C14:J14").ClearContents
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
MsgBox "Set Date and get busy. This is no time to rest!"
End Sub
TIA[/code]