シートがすでに存在する場合、Excelワークシートの名前を変更します

Question

以下のコードでは、「概要」という新しいシートを作成しようとしています。ただし、「概要」シートがすでに存在する場合は、エラーが発生します。 「要約」シートがすでに存在する場合、「要約X」（Xは1または2、または3、または...）という新しいシートを単に追加するにはどうすればよいですか。つまり、コードを実行するたびに、新しい「要約X」シートがエラーなしで追加されます。コードが二度目に実行された場合この場合は、ここで

はコードです....ように要約と概要[1]タブのがあるでしょう。ここでは簡単のサブです

Sub SearchFolders() 
'UpdatebySUPERtoolsforExcel2016 
    Dim xFso As Object 
    Dim xFld As Object 
    Dim xStrSearch As String 
    Dim xStrPath As String 
    Dim xStrFile As String 
    Dim xOut As Worksheet 
    Dim xWb As Workbook 
    Dim xWk As Worksheet 
    Dim xRow As Long 
    Dim xFound As Range 
    Dim xStrAddress As String 
    Dim xFileDialog As FileDialog 
    Dim xUpdate As Boolean 
    Dim xCount As Long 
    On Error GoTo ErrHandler 
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker) 
    xFileDialog.AllowMultiSelect = False 
    xFileDialog.Title = "Select a forlder" 
    If xFileDialog.Show = -1 Then 
     xStrPath = xFileDialog.SelectedItems(1) 
    End If 
    If xStrPath = "" Then Exit Sub 
    xStrSearch = "failed" 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    ' Create the report sheet at first position then name it "Summary" 
    Dim wsReport As Worksheet, rCellwsReport As Range 
    Set wsReport = ThisWorkbook.Sheets.Add(Before:=ThisWorkbook.Sheets(1)) 
    wsReport.Name = "Summary" 
    Set rCellwsReport = wsReport.Cells(2, 2) 
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
    xUpdate = Application.ScreenUpdating 
    Application.ScreenUpdating = False 
    Set xOut = wsReport 
    xRow = 1 
    With xOut 
     .Cells(xRow, 1) = "Workbook" 
     .Cells(xRow, 2) = "Worksheet" 
     .Cells(xRow, 3) = "Cell" 
     .Cells(xRow, 4) = "Test" 
     .Cells(xRow, 5) = "Limit Low" 
     .Cells(xRow, 6) = "Limit High" 
     .Cells(xRow, 7) = "Measured" 
     .Cells(xRow, 8) = "Unit" 
     .Cells(xRow, 9) = "Status" 
    End With 

    MsgBox xCount & "cells have been found", , "SUPERtools for Excel" 
ExitHandler: 
    Set xOut = Nothing 
    Set xWk = Nothing 
    Set xWb = Nothing 
    Set xFld = Nothing 
    Set xFso = Nothing 
    Application.ScreenUpdating = xUpdate 
    Exit Sub 
ErrHandler: 
    MsgBox Err.Description, vbExclamation 
    Resume ExitHandler 
End Sub 

Answer 1

ますお客様のニーズに合わせて変更することができます：

Sub setSheets() 
Dim ws As Worksheet, wsReport 
Dim i As Long 

For Each ws In ActiveWorkbook.Worksheets 
    If ws.Name Like "Summary*" Then 
     i = i + 1 
    End If 
Next ws 

Set wsReport = ThisWorkbook.Sheets.Add 
If i > 0 Then 
    wsReport.Name = "Summary" & i + 1 
Else 
    wsReport.Name = "Summary" 
End If 

End Sub