从主表创建工作表并在 Excel 中超链接它们

Question

1. 我有一个按行列出所有数据的主工作表。
2. 为每条唯一记录添加更多详细信息的模板
3. 需要为“C”列中的每个条目创建一个工作表，并使用相应行的名称 (D) 和联系人 (E) 列中的详细信息更新模板。
4. 然后将相应的工作表与行中的条目超链接。

在这里的几篇文章的帮助下，我能够在下面运行创建表格的代码，但我需要帮助从主表格填充模板中的数据并创建超链接

Option Explicit
Sub SheetsFromTemplate()
Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wasVISIBLE As Boolean
Dim shNAMES As Range, Nm As Range

With ThisWorkbook                
    Set wsTEMP = .Sheets("Template")
    wasVISIBLE = (wsTEMP.Visible = xlSheetVisible) 
    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetVisible 
    
    Set wsMASTER = .Sheets("Master")

    Set shNAMES = wsMASTER.Range("C4:C" & Rows.Count).SpecialCells(xlConstants) 
    
    Application.ScreenUpdating = False
    For Each Nm In shNAMES
        If Not Evaluate("ISREF('" & CStr(Nm.Text) & "'!A1)") Then
           wsTEMP.Copy After:=.Sheets(.Sheets.Count)
           ActiveSheet.Name = CStr(Nm.Text)
        End If
    Next Nm
    
    wsMASTER.Activate 
    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetHidden
    Application.ScreenUpdating = True
End With

     MsgBox "All sheets created"
End Sub

经常更新的主表

示例工作表

模板

Answer 1

试试这样的：

Sub SheetsFromTemplate()
    
    Dim wsMaster As Worksheet, wsTemp As Worksheet, wasVisible As Boolean
    Dim shNames As Range, Nm As Range, wsEntry As Worksheet, entryName
    
    With ThisWorkbook
        Set wsTemp = .Sheets("Template")
        wasVisible = (wsTemp.Visible = xlSheetVisible)
        If Not wasVisible Then wsTemp.Visible = xlSheetVisible
        
        Set wsMaster = .Sheets("Master")
    
        Set shNames = wsMaster.Range("C4:C" & Rows.Count).SpecialCells(xlConstants)
        
        Application.ScreenUpdating = False
        For Each Nm In shNames
            entryName = Nm.Text
            Set wsEntry = Nothing 'EDIT
            On Error Resume Next 'ignore error if no sheet with this name
            Set wsEntry = .Sheets(entryName)
            On Error GoTo 0 'stop ignoring errors
            If wsEntry Is Nothing Then
               wsTemp.Copy After:=.Sheets(.Sheets.Count)
               Set wsEntry = .Sheets(.Sheets.Count) 'get the copy
               wsEntry.Name = CStr(Nm.Text)
            End If
            With wsEntry
                'transfer/update values from Master sheet
                .Range("B2").Value = entryName
                .Range("B3").Value = Nm.Offset(0, 1)
                '...etc
                wsMaster.Hyperlinks.Add Anchor:=Nm, Address:="", _
                    SubAddress:=wsEntry.Range("A1").Address(, , , True), _
                    TextToDisplay:=Nm.Text
            End With
        Next Nm
        
        wsMaster.Activate
        If Not wasVisible Then wsTemp.Visible = xlSheetHidden
        Application.ScreenUpdating = True
    End With
    MsgBox "All sheets created"
End Sub