create multiple sheets with new date for each sheet

[RandyD123]

So far I have this to create sheets:

Sub SheetCopier()
   Dim x As Integer
   
   x = InputBox("Enter number of times to copy default sheet")
   For numtimes = 1 To x
      'Loop by using x as the index number to make x number copies.
      ActiveWorkbook.Sheets("Default").Copy _
         Before:=ActiveWorkbook.Sheets("Default")
         'Put copies in Before Default Sheet.
   Next
End Sub

So when I run that it lets me decide how many copies of the "Default" sheet I want. However I would like to also have the option to name those sheets I create with a date for each new sheet made (Nov 17 2017) or (111717) using a starting date of my choosing and having each sheet advance 1 day with the new name. (Nov 17 2017), (Nov 18 2017),.......

Also what I have now, if I cancel it, it errors out.

Thank you in advance if anyone can help.

 

[Fluff]

How about

Sub SheetCopier()
   Dim x As Long
   Dim NumTimes As Long
   Dim Dt As Date
   
   Dt = InputBox("Please enter a date")
   x = InputBox("Enter number of times to copy default sheet")
   
   For NumTimes = 1 To x
      'Loop by using x as the index number to make x number copies.
      ActiveWorkbook.Sheets("Exist").Copy _
         Before:=ActiveWorkbook.Sheets("Exist")
    ActiveSheet.Name = Format(Dt + NumTimes - 1, "mmm-dd-yyyy")
         'Put copies in Before Default Sheet.
   Next
End Sub

 

[RandyD123]

How about

Sub SheetCopier()
   Dim x As Long
   Dim NumTimes As Long
   Dim Dt As Date
   
   Dt = InputBox("Please enter a date")
   x = InputBox("Enter number of times to copy default sheet")
   
   For NumTimes = 1 To x
      'Loop by using x as the index number to make x number copies.
      ActiveWorkbook.Sheets("Exist").Copy _
         Before:=ActiveWorkbook.Sheets("Exist")
    ActiveSheet.Name = Format(Dt + NumTimes - 1, "mmm-dd-yyyy")
         'Put copies in Before Default Sheet.
   Next
End Sub

I get "subscript out of range" error. Disregard, I had to the sheet name!! work perfectly!!! Thank You!!@

 

[Fluff]

Apologies, i forgot to change the sheet names after testing.
You'll need to change them back

 

[Truiz]

Try:

Sub SheetCopier()
[COLOR=#333333]On Error GoTo GetOut[/COLOR]
   Dim x As Integer
   i = 0
   x = InputBox("Enter number of times to copy default sheet")
   For numtimes = 1 To x
      Ndate = Format(DateAdd("d", i, Date), "[$-409]mmmm d yyyy;@")
      ActiveWorkbook.Sheets("Default").Copy _
         Before:=ActiveWorkbook.Sheets("Default")
         ActiveSheet.Name = Ndate
         i = i + 1
   Next
[COLOR=#333333]GetOut:[/COLOR]
End Sub

 

[RandyD123]

only one issue, if I cancel the script I get an error. "Type mismatch".......

 

[Fluff]

Try this

Sub SheetCopier()
   Dim x As Long
   Dim NumTimes As Long
   Dim DAns As String
   Dim XAns As String
   Dim Dt As Date
   
   DAns = InputBox("Please enter a date")
   If Len(DAns) = 0 Then Exit Sub
   Dt = CDate(DAns)
   XAns = InputBox("Enter number of times to copy default sheet")
   If Len(XAns) = 0 Then Exit Sub
   x = CLng(XAns)
   For NumTimes = 1 To x
      'Loop by using x as the index number to make x number copies.
      ActiveWorkbook.Sheets("Exist").Copy _
         Before:=ActiveWorkbook.Sheets("Exist")
    ActiveSheet.Name = Format(Dt + NumTimes - 1, "mmm-dd-yyyy")
         'Put copies in Before Default Sheet.
   Next
End Sub

 

[RandyD123]

Thank You , I just added the "getout" to your original. I needed to be able to pick the date just to be on the safe side.

 

[Fluff]

Glad to help & thanks for the feedback