Have Code for New Workbook, but Want it in Same Workbook

kaskytrinh

New Member
Joined
Mar 29, 2013
Messages
21
I have the code that creates Excel sheets titled and formatted the way I want into a new workbook. However, I want to have this done in the current workbook instead. I'm just returning back to VBA after a decade and I just don't remember it...

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

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.
Try
Code:
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = MyNewSHeetName
 
Upvote 0
Well your code is a bit of a mess. but all this
Rich (BB code):
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

can be replaced as I see it by my code above, only that MySheetName would be the formula in the last line of the code I am saying you can replace.

play about with it on a copy of the sheet
 
Upvote 0
Hrmm, doesn't seem to like that...I think I'm all confused with the dim now.

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))
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = MonthName(Month(MonthX)) & " " & i
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
 
Upvote 0
can you please reply using the advanced (Go advanced button) version and then click on the code tag button (or use [ code][/code] ) to enclose your code in? That makes it easier to read.

I am still not sure what you are trying to achieve because your code seems to want to rename all the sheets in the workbook, and copy the same range into them.

This code is to create one sheet in the current workbook and copy the active sheet inot it
Code:
Option Explicit

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))
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = MonthName(Month(MonthX)) & " " & i
        Set WS = ActiveSheet
        TempRange.Copy
        With WS.Range(RangeString)
            .PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
            .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
        End With
    Else
        MsgBox "Error while inputing start date. Please try again!"
    End If
End Sub
 
Upvote 0
If you repeatedly create sheets with exactly the same layout and formatting and maybe formulas, then I would make a template sheet, hide it. Then the macro makes a copy of the sheet renames it and copies in the data.
A lot easier and quicker.
 
Upvote 0
I have an Excel sheet with information on it. This information is exactly the same on about 30 different sheets labeled for every day of the current month. At the beginning of every month, I need to create about 30 new worksheets labeled with all of the days of the current month (April 1, April 2, April 3...April 30). All 30 of these new sheets must be labeled with the days and must have the same information as the starting sheet. The code that I have *works* but it creates all of the sheets in a new workbook. I'd like for all of the sheets to be created and labeled in the current workbook. Does this help?

Code:
<code>
Sub AddSheets1()
    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 = Workbook.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


</code>
 
Upvote 0
Code:
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
    
    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
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = MonthName(Month(MonthX)) & " " & i
            Set WS = ActiveSheet
            TempRange.Copy
            With WS.Range(RangeString)
                .PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
                    SkipBlanks:=False, Transpose:=False
                .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                    SkipBlanks:=False, Transpose:=False
            End With
        Next i
    Else
        MsgBox "Error while inputing start date. Please try again!"
    End If
    Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,557
Latest member
richa mishra

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
Back
Top