如何基于特定列而不是可变行中单元格的值命名工作表，同时创建/复制工作表？

Question

本质上，我正在创建一个跟踪表，上面将带有一个单元格，单击该单元格将在同一工作簿中创建一个新的Excel表。 为了进行测试，我目前只是让它创建一个新工作表，但最终我会得到一个要复制的工作表。 我需要帮助的是，如何使VB提取一个单元格值用作新的/已复制工作表的名称？ 这是场景：

每行将有一个Client列（即C列），我想将其用作将要创建的工作簿的名称。 我正在尝试创建一个单元格（例如该行中的R列），单击该单元格将创建一个新工作表，并将该行中C列的值作为工作表的名称。

因此，假设第5行在C5中具有“测试客户端”。 单击R5时，我希望它创建一个名为“ Test Client”的工作表。 我已经看到了使用循环遍历该列并为每个循环创建工作表的解决方案，但是这对于我的场景而言并不能真正起作用，因为我需要即时创建它们，而不是总是为每一行创建它们。

我知道如何在vb中创建工作表，但我的问题是获取名称。 有没有办法让vba从激活它的行的C列中提取名称？ 因此，如果为第5行激活了它，则拉C5；如果为第10行激活了它，则拉C10，依此类推。

任何建议将不胜感激，我目前正在使用它来创建工作表：

Sub CreateSheet()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:= _
         ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
End Sub

这个叫：

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 

If Target.Row > 5 And Target.Column = 18 And Target.Count = 1 Then Call CreateSheet

End Sub

Answer 1

下面的代码读取相关行的C列中的值，然后将其作为String传递给您的Function：

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Row > 5 And Target.Column = 18 And Target.Count = 1 Then
    Dim ShtName         As String

    ShtName = Cells(Target.Row, "C").Value
    Call CreateSheet(ShtName)
End If

End Sub

这是您的函数，我添加了一个传递的代表工作表名称的String ：

Public Sub CreateSheet(ws_Name As String)

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:= _
         ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))

ws.Name = ws_Name

End Sub

Answer 2

更新：正如Shai Rado指出的那样，我缺少一个错误处理程序。

您应该测试看看工作表是否首先存在。 这种模式将使调试和向代码添加功能变得更加容易。

工作表模块

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim ws As Worksheet
    Dim WorksheetName As String

    If Target.Row > 5 And Target.Column = 18 And Target.Count = 1 Then

        WorksheetName = Cells(Target.Row, "C").Value

        Set ws = getWorkSheet(WorksheetName)

        If Not ws Is Nothing Then Set ws = getNewWorkSheet(WorksheetName)           

    End If

End Sub

标准模块

Function getWorkSheet(WorksheetName As String, Optional WorkbookName As String) As Worksheet
    If Len(WorkbookName) = 0 Then WorkbookName = ThisWorkbook.Name

    With Workbooks(WorkbookName)
        On Error Resume Next
        Set getWorkSheet = .Worksheets(WorksheetName)
        On Error GoTo 0
    End With

End Function

Function getNewWorkSheet(WorksheetName As String, Optional WorkbookName As String) As Worksheet
    Dim ws As Worksheet

    If Len(WorkbookName) = 0 Then WorkbookName = ThisWorkbook.Name

    With Workbooks(WorkbookName)
        Set ws = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
        On Error Resume Next
        ws.Name = WorksheetName

        If Err.Number = 0 Then
            Set getNewWorkSheet = ws
        Else
            ws.Delete
        End If
        On Error GoTo 0

    End With
End Function