单元格(范围内)更改后创建新工作表

Posted

技术标签:

【中文标题】单元格(范围内)更改后创建新工作表【英文标题】:create new worksheet after cell (in a range) change 【发布时间】:2016-12-29 13:30:11 【问题描述】:

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

结束子

【问题讨论】:

【参考方案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

【讨论】:

完美。谢谢。 lastrow 和 A2:A20 是其他请求的一部分。感谢您的忽略。

以上是关于单元格(范围内)更改后创建新工作表的主要内容,如果未能解决你的问题,请参考以下文章

根据单元格值合并范围内的单元格,但最后一个单元格没有被合并

Excel VBA 在给定范围的情况下使用表格内的单元格

如果选定的单元格在范围内,Excel 删除行

VBA 如何批量将单元格复制到另一个工作表中

引用查询函数中的单元格不包含在谷歌表格的范围内

当单元格被公式更改时,VBA 代码不运行