如果工作表已存在，请重命名excel工作表

在下面的代码中，我试图创建一个名为“摘要”的新工作表。但是，如果“摘要”表已经存在，我会得到一个错误。如何简单地添加一个名为“Summary X”的新工作表（如果“Summary”工作表已经存在，那么X是1、2、3或…）。也就是说，每次运行代码时，都会添加一个没有错误的新“Summary X”工作表。在这种情况下，如果代码是第二次运行的，那么将有一个Summary和Summary 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

---

这里有一个快速接头，您可以根据需要进行修改：

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

---

这里有一个快速接头，您可以根据需要进行修改：

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