none
Duplicate a worksheet, rename the destination if a worksheet exists conitnue name numbering for the copy RRS feed

  • Question

  • Hello there,

    I have a worksheet with duplicate sheets that were created by copying a worksheet using Copy() function. As a result, names of these duplicate worksheets were automatically generated by Excel with added increment, like

    My worksheet, My worksheet (1), My worksheet (2)

    I want to be able to copy the original My worksheet and conitnue the numbering for existing set. For the illustrated example, if I copy My worksheet, I want the copy to get the name of My worksheet (3).

    How would I do that?

    I have created a function that checks if a worksheet already exists in the workbook:

    Function CheckWorksheetExists(wsName As String)
        On Error GoTo ErrHndl
        Dim ws As Worksheet
            Set ws = Sheets(wsName)
            CheckWorksheetExists = True
        Exit Function
    ErrHndl:
        CheckWorksheetExists = False
    End Function

    However, can't figure out how to make Copy to get the new name if CheckWorksheetExists returns TRUE.

    Sub WsCopy() Dim numws As Integer numws = InputBox("Copies to create for the active sheet:") For numtimes = 1 To numws If Not (CheckWorksheetExists(ActiveSheet.Name)) Then ActiveSheet.Copy After:=ActiveSheet Else

    ' ' what should be here?

    ' End If Next End Sub


    Could somebody please help to do that? How do I figure the last member of My worksheet (n) sequence and copy the first My worksheet continuing this sequence?

    Thank you.


    Monday, July 22, 2019 4:34 PM

Answers

  • Try this:

        numws = InputBox("Copies to create for the active sheet:")
        
        Dim ws As Worksheet: Set ws = ActiveSheet
        Dim re As New RegExp: re.Pattern = "(.+?)(\s*\(\d+\))*$"
        Dim mc As MatchCollection: Set mc = re.Execute(ws.Name)
        
        Dim np As String
        
        Dim m As Match: Set m = mc(0)
        np = m.SubMatches(0)
        
        For numtimes = 1 To numws
        
            Dim i As Integer
            Dim n As String
            
            For i = 1 To 10000
            
                n = np & " (" & i & ")"
                
                If Not CheckWorksheetExists(n) Then
                    ActiveSheet.Copy After:=ActiveSheet
                    ActiveSheet.Name = n
                    Exit For
                End If
            Next
        Next

    It reuses the names of previously deleted worksheets.

    Add a reference to “Microsoft VBScript Regular Expressions 5.5”.



    • Edited by Viorel_MVP Monday, July 22, 2019 6:16 PM
    • Marked as answer by Stacy Ryutt Thursday, July 25, 2019 7:20 AM
    Monday, July 22, 2019 5:58 PM

All replies

  • Try this:

        numws = InputBox("Copies to create for the active sheet:")
        
        Dim ws As Worksheet: Set ws = ActiveSheet
        Dim re As New RegExp: re.Pattern = "(.+?)(\s*\(\d+\))*$"
        Dim mc As MatchCollection: Set mc = re.Execute(ws.Name)
        
        Dim np As String
        
        Dim m As Match: Set m = mc(0)
        np = m.SubMatches(0)
        
        For numtimes = 1 To numws
        
            Dim i As Integer
            Dim n As String
            
            For i = 1 To 10000
            
                n = np & " (" & i & ")"
                
                If Not CheckWorksheetExists(n) Then
                    ActiveSheet.Copy After:=ActiveSheet
                    ActiveSheet.Name = n
                    Exit For
                End If
            Next
        Next

    It reuses the names of previously deleted worksheets.

    Add a reference to “Microsoft VBScript Regular Expressions 5.5”.



    • Edited by Viorel_MVP Monday, July 22, 2019 6:16 PM
    • Marked as answer by Stacy Ryutt Thursday, July 25, 2019 7:20 AM
    Monday, July 22, 2019 5:58 PM
  • Use this macro:

    Sub WsCopy2()
        Dim numWS As Integer
        Dim ws As Worksheet
        Dim numTimes As Integer
        Dim iMax As Integer
        Dim shtT As Worksheet
        
        Set ws = ActiveSheet
        
        For Each shtT In Worksheets
            If shtT.Name Like ws.Name & " (*" Then
                iMax = Application.Max(iMax, Trim(Replace(Split(shtT.Name, "(")(1), ")", "")))
            End If
        Next shtT
        
        numWS = InputBox("Copies to create for the active sheet:")
        
        
        For numTimes = iMax + 1 To iMax + numWS
            ws.Copy After:=Worksheets(ws.Name & IIf(numTimes <> 1, _
                " (" & numTimes - IIf(iMax <> 0, 1, 0) & ")", ""))
        Next numTimes

    End Sub


    Monday, July 22, 2019 6:05 PM
  • Thank you, Viorel_!

    Worked perfectly. 

    • Edited by Stacy Ryutt Thursday, July 25, 2019 7:23 AM
    Tuesday, July 23, 2019 7:20 AM
  • Thank you, Bernie!

    One question. This expression

    iMax = Application.Max(iMax, Trim(Replace(Split(shtT.Name, "(")(1), ")", "")))

    evaluates to Type mismatch whenever this

    If shtT.Name Like ws.Name & " (*" Then

    is TRUE.

    So whever the "sheetname (1)" is found, and the IF expression above evaluates, a type mismatch error occurs.

    Why could be that?

    Thank you.


    • Edited by Stacy Ryutt Thursday, July 25, 2019 1:46 PM
    Thursday, July 25, 2019 7:22 AM
  • That code is meant to find the highest number copy of your sheet, and always worked in my testing. But, it will fail if you have a sheet name that has a string within parens, along the lines of 

    Sheet1(Test)(2)

    What is the sheet name of the activesheet that you are trying to make copies of?

    Friday, July 26, 2019 2:26 PM