Copying sheet multiple times while renaming certain ones

[WCAconsulting]

First time posting here, but have found many answers to questions by searching before. Hoping someone might have an answer on how to do the following:
1. I have a locked sheet that has very limited abilities to format anything due to a macro that allows uploading to a specific database.
2. Need to copy one sheet "x" number of times
3. Need to rename the "x" number of copied sheets in sequential order without renaming some others
4. Need to insert the sequential number "x" into a cell located in the sheet I am copying.

I have found these two macros that work. The Copy Sheets one works flawlessly and does not effect uploading.
The Renaming Sheets one works great, but changes the name of a reference tab the uploading macro is looking for. Is there anyway for it to only rename the copied sheets?

Sub Copysheet()

Dim i As Integer
Dim p As Integer
On Error GoTo out
i = InputBox("How many copies do you what?", "Making Copies")

Application.ScreenUpdating = False
p = 0
Do
ActiveSheet.Copy After:=Sheets(Sheets.Count)
p = p + 1
Loop Until p = i
Application.ScreenUpdating = True
Exit Sub
out:
MsgBox "copy was cancelled"
Application.ScreenUpdating = True
End Sub

Sub RenamingSheets()
nmbr = InputBox("What's the first number you want to name the sheets?", "Renaming Sheets")
For ws = 1 To Worksheets.Count
Sheets(ws).Name = "Stim Rpt Stage" & nmbr
nmbr = nmbr + 1
Next ws
End Sub

 

[Logit]

.

Option Explicit


Sub Copysheet()


Dim i As Integer
Dim p As Integer
On Error GoTo out
i = InputBox("How many copies do you what?", "Making Copies")


Application.ScreenUpdating = False
p = 0
Do
ActiveSheet.Copy After:=Sheets(Sheets.Count)
p = p + 1
Loop Until p = i
Application.ScreenUpdating = True
Call RenamingSheets
Exit Sub
out:
MsgBox "An error occurred", vbCritical, "Unknown Error"
Exit Sub
Application.ScreenUpdating = True
End Sub


Sub RenamingSheets()
Dim nmbr As Integer
Dim wsht As Worksheet
nmbr = InputBox("What's the first number you want to name the sheets?", "Renaming Sheets")
    For Each wsht In Sheets
        If wsht.Name <> "Sheet1" And wsht.Name <> "Sheet2" And wsht.Name <> "Sheet3" Then
            wsht.Name = "Stim Rpt Stage" & nmbr
            nmbr = nmbr + 1
        End If
    Next wsht


End Sub

 

[My Aswer Is This]

You should not need to scripts to do this task:
Try this:

Sub C0py_Sheets()
'Modified 3-31-18 10:50 PM EDT
On Error GoTo M
Application.ScreenUpdating = False
Dim i As Long
Dim ans As Long
sh = ActiveSheet.Name
ans = InputBox("How many copies do you what?", "Making Copies")
Nmbr = InputBox("What's the first number you want to name the sheets?", "Renaming Sheets")
For i = 1 To ans
    Sheets(sh).Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Stim Rpt Stage" & Nmbr: Nmbr = Nmbr + 1
Next
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "That sheet name already exist or is a improper name"
Application.ScreenUpdating = True
End Sub

 

[WCAconsulting]

Thanks!! That worked great on the copy and rename. I had messed around with it for a few hours and could not get them to work, but I am also not that great at VB either.

Any idea on how to add code to insert only the number appearing after the new name, Sim Rpt Stage XX, into cell I4 as a simultaneous operation?

 

[Logit]

.
With my macro, add one line (in bold) :

Sub RenamingSheets()
Dim nmbr As Integer
Dim wsht As Worksheet
nmbr = InputBox("What's the first number you want to name the sheets?", "Renaming Sheets")
    For Each wsht In Sheets
        If wsht.Name <> "Sheet1" And wsht.Name <> "Sheet2" And wsht.Name <> "Sheet3" Then
            wsht.Name = "Stim Rpt Stage" & nmbr
[B]            wsht.Range("I4").Value = nmbr '<<<--- adds number to cell I4[/B]
            nmbr = nmbr + 1
        End If
    Next wsht
End Sub

 

[My Aswer Is This]

Try this:

Sub C0py_Sheets()
'Modified 4-1-18 3:20 PM EDT
On Error GoTo M
Application.ScreenUpdating = False
Dim i As Long
Dim ans As Long
sh = ActiveSheet.Name
ans = InputBox("How many copies do you what?", "Making Copies")
Nmbr = InputBox("What's the first number you want to name the sheets?", "Renaming Sheets")
For i = 1 To ans
    Sheets(sh).Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Stim Rpt Stage" & Nmbr
    ActiveSheet.Range("I4").Value = Nmbr: Nmbr = Nmbr + 1
Next
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "That sheet name already exist or is a improper name"
Application.ScreenUpdating = True
End Sub

 

[WCAconsulting]

I owe someone a beer, or case, maybe a keg!!! Thank you so much. These little tweeks now save me about 45 minutes everyday.

 

[My Aswer Is This]

I owe someone a beer, or case, maybe a keg!!! Thank you so much. These little tweeks now save me about 45 minutes everyday.

Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.

 

[Logit]

Glad you found your answer.