Macro to add new sheets to current workbook

[kaskytrinh]

I have the code, below, that creates Excel sheets titled and formatted the way I want into a new workbook. It creates X number of worksheets according to how many days in the month that is entered. However, I want to have the worksheets added to the CURRENT workbook--not open and create a new workbook. Specifically, I want the new sheets added immediately after the active worksheet. Help please?

I'm just returning back to <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-bottom-style: dotted; border-bottom-color: rgb(0, 0, 0); cursor: help; color: rgb(51, 51, 51); background-color: rgb(250, 250, 250);">VBA</acronym> after a decade and I just don't remember how to do it. My knowledge is very limited.

Sub AddSheets()
Dim WS As Worksheet, WB As Workbook, TempWs As Worksheet, TempRange As Range
Dim MonthX As Date, Control As Variant, DaysInMonth As Byte, i As Byte, OldSheetCount As Byte
Dim RangeString As String

Set TempWs = ActiveSheet
RangeString = "A1:Z322"
Set TempRange = TempWs.Range(RangeString)
Control = InputBox("Enter month in the form of mm/yyyy.", "Month Entry", Month(Date) & "/" & Year(Date))
If IsDate(Control) Then
MonthX = CDate(Control)
DaysInMonth = Day(DateSerial(Year(MonthX), Month(MonthX) + 1, 0))
OldSheetCount = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = DaysInMonth
Set WB = Workbooks.Add
Application.SheetsInNewWorkbook = OldSheetCount
i = 1
For Each WS In WB.Sheets
WS.Name = MonthName(Month(MonthX)) & " " & i
TempWs.Activate
TempRange.Select
Selection.Copy
WS.Activate
WS.Range(RangeString).Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
i = i + 1
Next
Else
MsgBox "Error while inputing start date. Please try again!"
End If
End Sub

 

[JLGWhiz]

You can try this on a copy of your file. I think I covered everything, but I did not test it. It should add the mumber of sheets based on the date entered into the input box, one at a time, naming and formatting each one as it goes.

Sub AddSheets()
Dim WS As Worksheet, WB As Workbook, TempWs As Worksheet, TempRange As Range
Dim MonthX As Date, Control As Variant, i As Long
Dim RangeString As String
Application.ScreenUpdating = False
Set TempWs = ActiveSheet
RangeString = "A1:Z322"
Set TempRange = TempWs.Range(RangeString)
Control = InputBox("Enter month in the form of mm/yyyy.", "Month Entry", Month(Date) & "/" & Year(Date))
    If IsDate(Control) Then
         MonthX = CDate(Control)
        DaysInMonth = Day(DateSerial(Year(MonthX), Month(MonthX) + 1, 0))
            For i = 1 To DaysInMonth
                Set WS = Sheets.Add After:=ThisWorkbook.ActiveSheet
                WS.Name = MonthName(Month(MonthX)) & " " & i
                TempWs.Activate
                TempRange.Select
                 Selection.Copy
                 WS.Activate
                 WS.Range(RangeString).Select
                 ActiveSheet.Paste
                 Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
                 SkipBlanks:=False, Transpose:=False
                 Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                 SkipBlanks:=False, Transpose:=False
        Next
    Else
         MsgBox "Error while inputing start date. Please try again!"
    End If
Appliction.ScreenUpdating = True
End Sub

 

[JLGWhiz]

I inadvertantly deleted the declaration for DaysInMonth. It should be 'DaysInMonth As Long' added back to the Dim statements.(without the apostrophes)

 

[kaskytrinh]

Thanks for the reply and the coding. It doesn't seem to be working though...