从主控表创建工作表并在Excel中对其进行超链接

Question

1. 我有一个以行列出所有数据的主工作表。
2. 为每个唯一记录添加更多详细信息的模板
3. 需要为“C”列中的每个条目创建一个工作表，并在名称（D）中使用详细信息更新模板

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

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