根据超链接单击将单元格值复制并粘贴到另一个工作表

Question

Hope you can help me.

I want to copy and paste a cells value based on when you click a hyperlink on that cell.

So for example, I have a sheet called Form1, I want to click on an ID in column A it will then copy the value of that cell and paste it to B2 in sheet1 and then take me to sheet 1.

Currently I have a macro that allows me to click on an active cell and then press a button which then does what is mentioned above. I just think a hyperlink press would be more user friendly and would result in less errors.

Here is the code I have at the moment:

Sub Rectangle13_Click()

ActiveCell.Copy Destination:=Sheets(“Sheet1”).range(“B2”)

Worksheets(“Sheet1”).Activate

End Sub

Any help would be appreciated! Thank you

Answer 1

Worksheet FollowHyperLink

• Copy this code to the sheet module of worksheet Form1 . From there, run the second sub to convert the A column to hyperlinks.
• Click away.

Option Explicit

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    If Not Intersect(Columns("A"), Target.Range) Is Nothing Then
        Me.Parent.Worksheets("Sheet1").Range("B2").Value = Target.Range.Value
    End If
End Sub

' Run this to create hyperlinks out of the values in column 'A'
' which will point to cell 'B2' in 'Sheet1'. You can then reformat
' the cells (remove underline, change font color, ...).
Private Sub CreateHyperlinks()
    Dim lRow As Long: lRow = Range("A" & Rows.Count).End(xlUp).Row
    Dim cell As Range
    For Each cell In Range("A2:A" & lRow).Cells
        cell.Hyperlinks.Add cell, "", "Sheet1!B2", , CStr(cell.Value)
    Next cell
End Sub

Answer 2

It is inconvenient to use Hyperlik , I think. If you try changing the cell value, you cannot simple click it and write something... But if you want that, you can create such a hyperlink in the next way:

Sub testAddHyperlink()
   Dim DestSh As Worksheet
   Set DestSh = Sheets("Sheet1") 'you can use any sheet name here
   ActiveSheet.Hyperlinks.Add Range("A1"), Address:="", SubAddress:="'" & DestSh.name & "'" & "!A1"
   'it will keep the existing cell value
End Sub

Then, please copy the next event code in the sheet code module (where the hyperlink exists):

Option Explicit

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
  Dim rngCopy As Range, shDest As Worksheet
   Set shDest = Sheets("Sheet1") 'you may use here any sheet name
   shDest.Range("B2").value = Target.Parent.Value 'the sheet where the hyperlink targets, is already activated...
End Sub

Answer 3

If you want to use the BeforeDoubleClick approach, paste this code into your Form1 worksheet object in the VBA editor...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Cells.Count = 1 And Target.Cells(1, 1).Column = 1 Then
        Cancel = True
        
        With ThisWorkbook.Worksheets("Sheet1")
            .Range("B2") = Target.Value
            .Activate
        End With
    End If
End Sub

... naturally, this is a base example and you may need to modify it accordingly. For example, when you double click, you may want to ignore the first row if it's a header and not invoke the core parts of the logic.

That will then do what you want.