How to create hyperlink to macro code to cut and paste? - excel

Question

I have an Excel sheet with 5 tabs, column A in each is where I want a clickable cell.
When that cell is clicked, I want it to cut the 4 cells to the right of it on the same row and paste it on the next tab.
Clicking A1 would cut B1, C1, D1, E1 and paste it on the next tab, on the next empty row.
Same with the next tab until that row has made it to the final tab.
All the data is on the first sheet, all the others are empty.
Once I click on the first sheet I want it to move to the next one, then when I click it on the next one I want it to move to the third one.
So far I have code that creates hyperlinks on the cells I highlight, but it displays (sheet name! cell number). I want to display a specific txt instead, like (complete) or (received). The display varies for each tab.
The code I have in the first sheet moves the cut row to the second sheet.
I tried pasting that code in the next sheet to move it to the third sheet but I get an error.
Code in module
Sub HyperActive()
Dim nm As String
nm = ActiveSheet.Name & "!"
For Each r In Selection
t = r.Text
addy = nm & r.Address(0, 0)
ActiveSheet.Hyperlinks.Add Anchor:=r, Address:="", SubAddress:= _
addy, TextToDisplay:=r.Text
Next r
End Sub
Code in sheet
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim r As Range
Set r = Range(Target.SubAddress)
r.Offset(0, 1).Resize(1, 4).Cut
Sheets("Wash Bay").Select
Worksheets("Wash Bay").Range("B" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
End Sub

Answer 1

I'd suggest using the Workbook_SheetFollowHyperlink event here. This is the workbook-level event, as opposed to the worksheet-level Worksheet_FollowHyperlink event.
From the docs:
Occurs when you choose any hyperlink in Microsoft Excel...
Parameters
Sh : The Worksheet object that contains the hyperlink
Target: The Hyperlink object that represents the destination of the hyperlink
Add the following code to the ThisWorkbook module (not the sheet code module).
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
If Sh.Index = Me.Worksheets.Count Then Exit Sub ' Do nothing if `Sh` is the last worksheet
Dim nextWs As Worksheet
Set nextWs = Me.Worksheets(Sh.Index + 1)
With nextWs
Dim lastRow As Long
lastRow = .Range("B" & .Rows.Count).End(xlUp).Row
End With
Dim rng As Range
Set rng = Sh.Range(Target.SubAddress)
rng.Offset(, 1).Resize(1, 4).Cut Destination:=nextWs.Range("B" & lastRow + 1)
Application.CutCopyMode = False
End Sub
IMPORTANT NOTE: In its current state, this assumes that the workbook only has worksheets (no chart sheets, for example).
EDIT: You can use this revised code if the workbook contains other sheet types besides worksheets:
Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
Dim indx As Long
indx = GetWorksheetIndex(Sh)
If indx = Me.Worksheets.Count Then Exit Sub
Dim rng As Range
Set rng = Sh.Range(Target.SubAddress)
Dim nextWs As Worksheet
Set nextWs = Me.Worksheets(indx + 1)
With nextWs
Dim lastRow As Long
lastRow = .Range("B" & .Rows.Count).End(xlUp).Row
End With
rng.Offset(, 1).Resize(1, 4).Cut Destination:=nextWs.Range("B" & lastRow + 1)
Application.CutCopyMode = False
End Sub
Private Function GetWorksheetIndex(ByVal ws As Worksheet) As Long
Dim w As Worksheet
For Each w In ws.Parent.Worksheets
Dim counter As Long
counter = counter + 1
If w.Name = ws.Name Then
GetWorksheetIndex = counter
Exit Function
End If
Next w
End Function
2nd EDIT:
I think you can rewrite HyperActive to something like this:
Sub HyperActive(ByVal rng As Range)
Dim ws As Worksheet
Set ws = rng.Parent
Dim fullAddress As String
fullAddress = "'" & ws.Name & "'!" & rng.Address
ws.Hyperlinks.Add Anchor:=rng, Address:="", SubAddress:=fullAddress, TextToDisplay:=rng.Text
End Sub
Then in the main Workbook_SheetFollowHyperlink code, add the following line:
HyperActive rng:=nextWs.Range("A" & lastRow + 1)