?? Code to Auto name new sheets as active sheet + 1?

[alelea91]

Hi.

I'm hoping for help with a code in Excel that will copy and automatically name the new sheet as 'active sheet' + 1. For example, if I am on a sheet titled "3", I would like for the new sheet to be titled "4"

Thanks to MyExcel.com, I have obtained code that creates a desired quantity of copies of the active sheet. It then prompts the user to input the name of each new sheet being copied. Because all the new sheets that I want to copy will be in ascending order (3, 4, 5, 6...), I would like to only have to input the desired number of copies of the active sheet. So, if I am on a sheet titled "5", I would like to be able to request 7 copies of it while having the copies automatically numbered (6, 7, 8, 9, 10, 11, 12).

The following is the working code that I currently have.

Public ws As Worksheet
Public i As Long


Sub CopySheetXTimes()
Dim NewName As String
Dim x As Long

i = Application.InputBox("How many copies do you want?", "Number of Copies?", Type:=1)

Set ws = ActiveSheet

For x = 1 To i
ws.Copy After:=Sheets(Sheets.Count)
NewName = InputBox("Enter the new sheet name", "New Sheet Name")

ActiveSheet.Name = NewName
Next x
Range("A16:E16").Select
ActiveCell.FormulaR1C1 = "=(R[-9]C[45]-1)*7+'1'!RC:RC[4]"

ws.Activate

End Sub




Thank you!

 

[JoeMo]

Sub CopySheetXTimes()
Dim NewName As String
Dim x As Long

i = Application.InputBox("How many copies do you want?", "Number of Copies?", Type:=1)
If i = "" Then Exit Sub  'user clicked Cancel

Set ws = ActiveSheet

For x = 1 To i
ws.Copy After:=Sheets(Sheets.Count)
If IsNumeric(Val(Sheets(Sheets.Count - 1).Name)) Then
    ActiveSheet.Name = Val(Sheets(Sheets.Count - 1).Name) + 1
Else
    NewName = InputBox("Enter the new sheet name", "New Sheet Name")
    ActiveSheet.Name = NewName
End If
Next x
Range("A16:E16").Select
ActiveCell.FormulaR1C1 = "=(R[-9]C[45]-1)*7+'1'!RC:RC[4]"

ws.Activate

End Sub

 

[chicagocomputerclasses]

This one will add to the last digit number in the sheet name or just the number.
So for Sheet1 it will copy Sheet2, Sheet3 etc. and for 1 it will got 2, 3 etc.

Sub CopySheetXTimes()
    Dim NewName As String
    Dim x As Long
    
    sir = ActiveSheet.Name
    l = Len(sir)
    While sir Like "*[0-9]"
        sir = Left(sir, l - 1)
        l = l - 1
    Wend
    num = Replace(ActiveSheet.Name, sir, "")
    
    If Len(sir) = 0 Then
        sir = ""
        num = ActiveSheet.Name
    End If
    
    
    i = Application.InputBox("How many copies do you want?", "Number of Copies?", Type:=1)
    
    Set ws = ActiveSheet
    
    For x = 1 To i
    ws.Copy After:=Sheets(Sheets.Count)
    
    ActiveSheet.Name = sir & (num + 1)
    num = num + 1
    Next x
    Range("A16:E16").Select
    ActiveCell.FormulaR1C1 = "=(R[-9]C[45]-1)*7+'1'!RC:RC[4]"
    
    ws.Activate
End Sub

 

[alelea91]

What a fast response! Thank you so much! I tried it and it works with what I am doing. Thank you very much. I really appreciate it. Wow, this is going to save me so much time.

This one will add to the last digit number in the sheet name or just the number.
So for Sheet1 it will copy Sheet2, Sheet3 etc. and for 1 it will got 2, 3 etc.

Sub CopySheetXTimes()
    Dim NewName As String
    Dim x As Long
    
    sir = ActiveSheet.Name
    l = Len(sir)
    While sir Like "*[0-9]"
        sir = Left(sir, l - 1)
        l = l - 1
    Wend
    num = Replace(ActiveSheet.Name, sir, "")
    
    If Len(sir) = 0 Then
        sir = ""
        num = ActiveSheet.Name
    End If
    
    
    i = Application.InputBox("How many copies do you want?", "Number of Copies?", Type:=1)
    
    Set ws = ActiveSheet
    
    For x = 1 To i
    ws.Copy After:=Sheets(Sheets.Count)
    
    ActiveSheet.Name = sir & (num + 1)
    num = num + 1
    Next x
    Range("A16:E16").Select
    ActiveCell.FormulaR1C1 = "=(R[-9]C[45]-1)*7+'1'!RC:RC[4]"
    
    ws.Activate
End Sub