Excel：重複のないワークシートを作成するVBA

Question

私はワークシートを作成するためのマクロを作成しようとしています。 コードは次のようにする必要があります。

1）「テンプレート」ワークシートのテンプレートを使用して、マスターシートからColumnBのワークシートを作成します。

2）マスターシートのColumnBの範囲は可変ですが、これはexcel-vbaの最初の試行で、可変範囲の設定方法はわかりません。

3）ColumnB

内の各セルに名前どおり

3.1を各ワークシートの名前を変更します）ColumnBは、重複したエントリを持っているが、我々は、重複するセルのための唯一の1のワークシートを作成する必要があります。 （重複を削除することはできません）

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

ソリューション説明：Duplicate_Templateが役立ちます
サブ：
SheetExistsは真の解決策は、その
ソリューションよりも複雑になり、問題が述べられて解決するためにきちんとした近似値ですがあなたはそうする。そして、同じ操作（私はこれを "ミラー関数"と呼ぶ）をする必要があるときはいつでも呼び出す方が簡単です。

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

非重複シートを作成するための機能の一般的なセット：

あなたは

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