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

[kaskytrinh]

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

 

[sijpie]

Try

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = MyNewSHeetName

 

[kaskytrinh]

Sorry, where am i adding this and do I need to take something out of my code?

 

[sijpie]

Well your code is a bit of a mess. but all this

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

 

[kaskytrinh]

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

 

[sijpie]

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

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

 

[sijpie]

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.

 

[kaskytrinh]

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

 

[sijpie]

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