Excel VBA技术问询：Master表C列变更时复制Codes表A2至对应B列

Hey there! Let's tackle that hyperlink paste issue you're facing. You've already nailed the change detection for column C in your Master sheet—awesome work. The problem with your current setup is that regular copy/paste doesn't reliably transfer hyperlink properties the way we need it to. Instead, we'll directly extract the hyperlink from Codes!A2 and apply it to the adjacent B column cell manually.

Here's the updated, complete Worksheet_Change event code you can use in your Master sheet's code module:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim monitoredRange As Range
    Dim cell As Range
    Dim hyperlinkCell As Range
    Dim hyperlinkAddr As String
    Dim hyperlinkText As String
    
    ' Set the range we're monitoring: column C in Master sheet
    Set monitoredRange = Me.Range("C:C")
    
    ' Exit if the changed range doesn't intersect with column C
    If Intersect(Target, monitoredRange) Is Nothing Then Exit Sub
    
    ' Disable events temporarily to prevent infinite loops
    Application.EnableEvents = False
    
    ' Get the hyperlink cell from Codes sheet
    Set hyperlinkCell = ThisWorkbook.Worksheets("Codes").Range("A2")
    
    ' Check if Codes!A2 actually has a hyperlink
    If hyperlinkCell.Hyperlinks.Count > 0 Then
        hyperlinkAddr = hyperlinkCell.Hyperlinks(1).Address
        hyperlinkText = hyperlinkCell.Hyperlinks(1).TextToDisplay
    Else
        ' If no hyperlink exists, just use the cell's text as fallback
        hyperlinkAddr = ""
        hyperlinkText = hyperlinkCell.Value
    End If
    
    ' Loop through each changed cell in column C (in case multiple cells were edited)
    For Each cell In Intersect(Target, monitoredRange)
        ' Reference the adjacent B column cell
        Dim targetCell As Range
        Set targetCell = cell.Offset(0, -1)
        
        ' Clear any existing hyperlinks in the target cell first
        targetCell.Hyperlinks.Delete
        
        ' Add the hyperlink if we have a valid address
        If hyperlinkAddr <> "" Then
            targetCell.Hyperlinks.Add _
                Anchor:=targetCell, _
                Address:=hyperlinkAddr, _
                TextToDisplay:=hyperlinkText
        Else
            ' If no hyperlink, just set the text
            targetCell.Value = hyperlinkText
        End If
    Next cell
    
    ' Re-enable events
    Application.EnableEvents = True
End Sub

Key Notes to Understand: #

• Event Disabling: We turn off Application.EnableEvents at the start to stop the code from triggering itself when we modify the B column cells—this prevents infinite loops.
• Hyperlink Extraction: Instead of copying/pasting, we directly pull the hyperlink's address and display text from Codes!A2 using the Hyperlinks collection.
• Handling Multiple Cells: The loop ensures that if someone edits multiple cells in column C at once, each gets the hyperlink in their adjacent B cell.
• Fallback for No Hyperlink: If Codes!A2 doesn't have a hyperlink, we just set the B cell's value to match Codes!A2's text as a safety net.

Important Setup Step: #

Make sure you paste this code directly into the Master worksheet's code module (not a standard module). To do this:

1. Right-click the Master sheet tab > View Code
2. Paste the code into the window that opens

That should resolve your paste issue and get the hyperlinks working exactly as you need!

内容的提问来源于stack exchange，提问作者Argus1956