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

我有单元格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")内的值已更改，下面的代码将创build一个新的工作表新的工作表名称等于单元格值。

该代码还validation没有退出表名称（这将导致一个错误）。

码

 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