Excel: VBA создавать рабочие листы без дубликатов

Question

Я пытался создать макросы для создания рабочих листов. Код должен делать следующее:

1) Создайте рабочие листы для столбца B с основного листа, используя шаблон из рабочего листа «Шаблон».

2) Диапазон значений столбца B в главном листе является переменным, но это моя первая попытка с excel-vba, и я не знаю, как установить диапазон переменных.

3) Переименовать каждый рабочий лист в соответствии с именем в каждой ячейке в ColumnB

3.1) ColumnB имеет повторяющиеся записи, но нам нужно создать только один лист для повторяющихся ячеек. (удаление дубликатов не является опцией)

4) Гиперссылка рабочих листов на ячейки в столбце B мастер-листа.

У меня проблемы с точкой 3.1, упомянутой выше. Ниже приведена самая близкая вещь, которую я нашел полезной: можем ли мы доработать ее по моим требованиям?

Sub CreateAndNameWorksheets() 
    Dim c As Range 

    Application.ScreenUpdating = False 
     For Each c In Sheets("Master").Range("B5:B25000") 
     Sheets("Template").Copy After:=Sheets(Sheets.Count) 
     With c 
      ActiveSheet.Name = .Value 
      .Parent.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:= _ 
       "'" & .Text & "'!A1", TextToDisplay:=.Text 
     End With 
    Next c 
    Application.ScreenUpdating = True 

End Sub 

Спасибо!

Answer 1

Решение Объяснение:
Хотя SheetExists является аккуратным приближение для решения вопроса заявил, что реальное решение будет более сложным, чем это
Решение:
Суб Duplicate_Template поможет вы это сделаете. И проще называть его всякий раз, когда вам нужно делать ту же операцию (я называю это «зеркальными функциями»).

Sub Duplicate_Template(TemplateToDuplicate As String, NameNewSheet As String) 
    If SheetExists(NameNewSheet) = False Then 
    Sheets(TemplateToDuplicate).Copy After:=Sheets(Sheets.Count) 
    ActiveSheet.Name = NameNewSheet 
    End If 
End Sub 
Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean 
    Dim sht As Worksheet 
    If wb Is Nothing Then Set wb = ThisWorkbook 
    On Error Resume Next 
    Set sht = wb.Sheets(shtName) 
    On Error GoTo 0 
    SheetExists = Not sht Is Nothing 
End Function 

Answer 2

Общий набор функций для создания не-дубликатов листов:

Вы можете использовать Cell.Values ​​из столбца B, как струны, чтобы проверить

Sub Test() 
    Call CreateNonDupeWS("Test1") 
    Call CreateNonDupeWS("Test2", "Test1") 
    Call CreateNonDupeWS("Test3", "Test1") 
    Call CreateNonDupeWS("Test1") 
End Sub 

Private Function CreateNonDupeWS(wsNew As String, Optional wsAfter As String) As Boolean 
On Error GoTo ExitSub 
    If IsMissing(wsAfter) Then wsAfter = Sheets(Sheets.Count).Name 
    If Not WorkSheetExists(wsNew) Then Worksheets.Add().Name = wsNew 
    If WorkSheetExists(wsAfter) Then Worksheets(wsNew).Move After:=Worksheets(wsAfter) 
    CreateNonDupeWS = True 
ExitSub: 
End Function 

Function WorkSheetExists(ByVal sName As String) As Boolean 
    On Error Resume Next 
    WorkSheetExists = Not ActiveWorkbook.Worksheets(sName) Is Nothing 
End Function