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

Question

在下面的代碼中，我試圖創建一個名爲「Summary」的新工作表。但是，如果「摘要」工作表已經存在，則會出現錯誤。如果「摘要」工作表已經存在，我如何簡單地添加一個名爲「摘要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