How do I copy a worksheet and change its name?

[jrice174]

I have some template worksheets in a workbook that I want to copy. The templates names start with "zz" to differentiate them from the other worksheets. I want to copy worksheet named "zzThisworksheet" to "Thisworksheet" and leave the "zzThisworksheet" unchanged. The code below does make the copy called "Thisworksheet" but it also renames "zzThisworksheet" to "zzThisworksheet (2)". Any ideas on how to fix this? (There are other template worksheets that are not visible, so that's why I have that one if statement).

Application.ScreenUpdating = False
For Each Wksht In ThisWorkbook.Worksheets
If Left(Wksht.Name, 2) = "zz" Then
If Wksht.Visible = True Then
L1 = Len(Wksht.Name)
LastSheetName = "Sheet2"
Workbooks(ThisWorkbook.Name).Activate
Workbooks(ThisWorkbook.Name).Worksheets(Wksht.Name).Visible = True
Workbooks(ThisWorkbook.Name).Sheets(Wksht.Name).Activate
Workbooks(ThisWorkbook.Name).Sheets(Wksht.Name).Select
Workbooks(ThisWorkbook.Name).Sheets(Wksht.Name).Copy After:=Workbooks(ThisWorkbook.Name).Sheets("Formato")
Sheets(Wksht.Name).Name = Right(Wksht.Name, L1 - 2)
End If
End If
Next
Application.ScreenUpdating = True
End Sub

 

[joerd]

Try this:

Dim Wksht As Worksheet, NewSht As Worksheet, LastSheet As Worksheet
Application.ScreenUpdating = False
Set LastSheet = ThisWorkbook.Sheets("Formato")

For Each Wksht In ThisWorkbook.Worksheets
    If Left(Wksht.Name, 2) = "zz" Then
        If Wksht.Visible = True Then
            Wksht.Copy After:=LastSheet
            Set NewSht = ThisWorkbook.Worksheets(LastSheet.Index + 1)
            On Error Resume Next    
            'if the sheet name exists, Error 1004 gets raised
            'abort renaming by resuming execution.
            NewSht.Name = Mid(Wksht.Name, 3)
        End If
    End If
Next

Application.ScreenUpdating = True
Set Wksht = Nothing
Set NewSht = Nothing
Set LastSheet = Nothing
End Sub

Cheers,
Joerd

Please see FAQ731-376 for tips on how to make the best use of Eng-Tips.