Macro excel для создания новых листов с именами на основе списка, но если повторные не создают

Question

Я могу создавать листы, включая его имя, на основе выбранного списка «имен» со следующим кодом (ниже), НО когда это ячейки с повторным именем, это создаст лист без имени и общий «лист ##». Я хочу, чтобы, если имя ячейки повторяется или есть лист уже с этим именем (то же самое), НЕ создайте новый лист.

Sub AddSheets() 
Dim cell As Excel.Range 
Dim wbToAddSheetsTo As Excel.Workbook 

Set wbToAddSheetsTo = ActiveWorkbook 
For Each cell In Selection 
With wbToAddSheetsTo 
    .Sheets.Add after:=.Sheets(.Sheets.Count) 
    On Error Resume Next 
    ActiveSheet.Name = cell.Value 
    If Err.Number = 1004 Then 
     Debug.Print cell.Value & " already used as a sheet name" 
    End If 
    On Error GoTo 0 
End With 

End Sub 

Answer 1

Проверьте, чтобы увидеть, если таблица существует до его создания:

Public Function WorkSheetExists(SheetName As String, wrkbk As Workbook) As Boolean 
    Dim wrkSht As Worksheet 
    On Error Resume Next 
     Set wrkSht = wrkbk.Worksheets(SheetName) 'Attempt to set reference to worksheet. 
     WorkSheetExists = (Err.Number = 0) 'Was an error generated - True or False? 
     Set wrkSht = Nothing 
    On Error GoTo 0 
End Function 

Затем в коде просто проверить, если он существует до его создания:

Sub AddSheets() 
    Dim cell As Excel.Range 
    Dim wbToAddSheetsTo As Excel.Workbook 

    Set wbToAddSheetsTo = ActiveWorkbook 
    For Each cell In Selection 
     **If Not (WorkSheetExists(cell.Value, wbToAddSheetsTo)) Then** 
      With wbToAddSheetsTo 
       .Sheets.Add after:=.Sheets(.Sheets.Count) 
       On Error Resume Next 
       ActiveSheet.Name = cell.Value 
       If Err.Number = 1004 Then 
        Debug.Print cell.Value & " already used as a sheet name" 
       End If 
       On Error GoTo 0 
      End With 
     **End If** 
    Next cell 

End Sub