Copy and create new name if sheet exist then + 1

[jtsains]

Ok i have spent nearly 2 hours looking through posts and trying to piece together what I need. I would be extremely appreciative if someone can help me with my code which doesn't work. I want it to copy the sheet "template" and create a copy named 1, if one exists then rename 2, if 2 exists then 3 and so forth.

When I get it to work it will loop through and go from 1 to 6 but not create sheets 2-5 for some reason.

I would also like to have it add the sheet in the "3rd Position" of the worksheets in my workbook, instead of adding it to the end. If this is possible, please help as well.

Sub CopySheet()

Dim ws As Worksheet
Set ws = Sheets("Template")
ws.Copy After:=Sheets(Sheets.Count)
newname = Null
newname = 1
Do
If SheetExists(newname) Then
Exit Do
Else
newname = newname + 1
End If
Loop
ActiveSheet.Name = newname
End Sub

Private Function SheetExists(newname) As Boolean
' Returns TRUE if sheet exists in the active workbook
Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(newname)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
End Function

 

[rs2k]

Hi there,

This is some (ever so slightly) adapted code that VoG posted here a while back, it should help you out;

Sub CopySheet()

Dim ws As Worksheet
Dim newname As String
Set ws = Sheets("Template")
newname = 1
ws.Copy after:=Sheets(Sheets.Count)

If WorksheetExists(newname) Then
    i = 1
    newname = i
    Do While WorksheetExists(newname)
        i = i + 1
        newname = i
    Loop
End If
ActiveSheet.Name = newname
End Sub

Function WorksheetExists(newname As String) As Boolean
On Error Resume Next
WorksheetExists = Worksheets(newname).Name = newname
On Error GoTo 0
End Function

HTH
Colin

 

[jtsains]

Thank you so much this works nearly perfectly. The one thing I still need to find is the ability to place the new worksheet in the 3rd position on the workbook instead of at the end.
This code moves it to the end:

ws.Copy after:=Sheets(Sheets.Count)

is there something i can replace this with to move it to the 3rd position always? (Esentially moving back all the other tabs?

 

[rs2k]

Hi There,

Try adding this line at the end of the code;

ActiveSheet.Move Before:=Sheets(3)

So the full code is now;

Sub CopySheet()
Dim ws As Worksheet
Dim newname As String
Set ws = Sheets("Template")
newname = 1
ws.Copy after:=Sheets(Sheets.Count)
If WorksheetExists(newname) Then
    i = 1
    newname = i
    Do While WorksheetExists(newname)
        i = i + 1
        newname = i
    Loop
End If
ActiveSheet.Name = newname
[COLOR=#FF0000]ActiveSheet.Move Before:=Sheets(3)[/COLOR]
End Sub

HTH
Colin

 

[jtsains]

Thank you SOO MUCH!!

I wish I could figure this stuff out on my own. This works perfectly!!