Excel: VBA erstellen Arbeitsblätter ohne Duplikate

Question

Ich habe versucht, ein Makro zum Erstellen von Arbeitsblättern zu erstellen. Der Code sollte Folgendes tun:

1) Erstellen Sie Arbeitsblätter für ColumnB von Master-Blatt, mit Vorlage aus "Vorlage" Arbeitsblatt.

2) Der Bereich von ColumnB in Master Sheet ist variabel, aber dies ist mein erster Versuch mit Excel-VBA, und ich weiß nicht, wie man einen variablen Bereich einstellt.

3) Benennen Sie jedes Arbeitsblatt nach dem Namen in jeder Zelle in columnB

3.1) columnB hat doppelte Einträge, aber wir brauchen nur ein Arbeitsblatt für doppelte Zellen erstellen. (Löschen von Duplikaten ist keine Option)

4) Verknüpfen Sie die Arbeitsblätter mit den Zellen in Spalte B des Master-Arbeitsblatts.

Ich habe Probleme mit dem oben erwähnten Punkt 3.1. Unten ist das nächste, was ich am nützlichsten fand: Können wir es nach meinen Anforderungen verfeinern?

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 

Vielen Dank!

Answer 1

Lösung Erklärung:
Während die SheetExists eine ordentliche Annäherung ist die Frage gesagt, die wirkliche Lösung zu lösen wäre komplizierter als die
Lösung:
Der Sub Duplicate_Template helfen Sie tun es. Und es ist einfacher, es immer dann aufzurufen, wenn Sie die gleiche Operation ausführen müssen (ich nenne das "Spiegelfunktionen").

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

Ein allgemeiner Satz von Funktionen nicht doppelte Blätter zu erstellen:

Sie die Cell.Values ​​aus Spalte B verwenden können, wie die Saiten

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