セル（範囲内）変更後に新しいワークシートを作成

Question

セルがA2からA20まで その範囲内のセル値が変更されたときに新しいワークシートを生成しますか？

さらに、生成された新しいワークシートの名前が、変更されたセルの名前に変更されます。

範囲は以下のコードはRange("A2:A20")内の値いったん新しいワークシートを作成したユーザー

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim KeyCells As Range 
Dim ws As Worksheet 
Dim lastrow As Long 
lastrow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row + 1 
Set KeyCells = Range("B5") 
If Not Application.Intersect(KeyCells, Range(Target.Address)) _ 
     Is Nothing Then 
For Each ws In Worksheets 
With ActiveSheet 
    If .Range("B5").Value <> "" Then .Name = .Range("B5").Value 
End With 
Cells(lastrow, "D").Value = Range("B5").Value 
End If 

End Subの

Answer 1

によって要求されたまで、私は、（単一セルのために）正常に動作し、このコードを持っていました新しいワークシート名はセル値と同じです。

このコードでは、その名前の終了シートがないことも確認されます（エラーが発生します）。

コード

Option Explicit 

Private Sub Worksheet_Change(ByVal Target As Range) 

Dim KeyCells As Range 
Dim ws As Worksheet 
Dim lastrow As Long 

' you are not doing anything currently with the last row 
'lastrow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row + 1 

' according to your post you are scanning Range A2:A20 (not B5) 
Set KeyCells = Range("A2:A20") 

If Not Intersect(KeyCells, Target) Is Nothing Then 
    For Each ws In Worksheets 
     ' if sheet with that name already exists 
     If ws.Name = Target.Value Then 
      MsgBox "A Worksheet with Cell " & Target.Value & " already exists" 
      Exit Sub 
     End If     
    Next ws 

    Set ws = Worksheets.Add 
    ws.Name = Target.Value   
End If 

End Sub