如果工作表已存在，则重命名 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