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

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