Macro to add new sheets to current workbook

kaskytrinh

New Member
Joined
Mar 29, 2013
Messages
21
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
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
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.
Code:
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
 
Last edited:

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
I inadvertantly deleted the declaration for DaysInMonth. It should be 'DaysInMonth As Long' added back to the Dim statements.(without the apostrophes)
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,517
Messages
5,837,791
Members
430,516
Latest member
thaling

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top