在单元格（范围内）更改后创建新工作表

Question

我有单元格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 

结束子

Answer 1

下面的代码创建一个新的工作表，一旦内部Range("A2:A20")的值已更改，新的工作表名称等于单元格值。

该代码还验证是否没有带该名称的退出工作表（这将导致出现错误）。

代码

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