如何基於特定列而不是可變行中單元格的值命名工作表，同時創建/復制工作表？

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