Как создать гиперссылку, связанную с кодом макроса, чтобы вырезать и вставить?

Question

Очень новое в Excel кодирование здесь, и я бьюсь головой об стену, пытаясь сделать это, прибегая к помощи, но кажется, что каждый раз, когда я нажимаю на ковер из одного места, оно всплывает из другого. LOL У меня есть превосходство. лист с 5 вкладками на нем, столбец A в каждой ячейке - это то место, где я хочу кликабельную ячейку. Когда щелкают по этой ячейке, я хочу, чтобы она обрезала 4 ячейки справа от нее в той же строке и вставляла их на следующей вкладке. Таким образом, нажатие на кнопку A1 обрезает B1, C1, D1, E1 и вставляет его на следующую вкладку, но в следующую доступную пустую строку. То же самое и со следующей вкладкой, пока эта строка не попадет на последнюю вкладку. Все данные находятся на первом листе, все остальные пусты. Поэтому, как только я щелкаю по нему на первом листе, я хочу, чтобы он переместился на следующий, затем, когда я щелкаю по нему на следующем листе, я хочу, чтобы он перешел на третий лист.

Пока у меня есть кодэто создает гиперссылки на ячейки, которые я выделил, но отображает (имя листа! номер ячейки), я хочу отображать вместо этого определенный текст, например (завершено) или (получено). Отображение меняется для каждой вкладки. Код, который у меня есть на первом листе, работает для перемещения строки обрезки на второй лист, но я попытался вставить этот код на следующем листе, чтобы переместить его на 3-й лист, но у меня продолжает появляться ошибка.

Заранее спасибо за помощь! Я чувствую себя виноватым, когда спрашиваю об этом, обычно я бы сидел и изучал весь процесс, но я просто потратил время здесь.

код в модуле

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

код в листе

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

Я бы предложил использовать здесь событие Workbook_SheetFollowHyperlink. Это событие workbook -уровня, в отличие от события * -level Worksheet_FollowHyperlink.

Из документов:

Происходит при выборе любой гиперссылки в Microsoft Excel ...

Параметры

Sh: объект Worksheet, который содержитгиперссылка

Target: объект Hyperlink, представляющий пункт назначения гиперссылки

Добавьте следующий код в модуль ThisWorkbook (немодуль кода листа).

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

ВАЖНОЕ ПРИМЕЧАНИЕ. В текущем состоянии предполагается, что рабочая книга имеет только рабочих листов (например, без диаграммных листов).

---

РЕДАКТИРОВАТЬ : Вы можете использовать этот пересмотренный код, если рабочая тетрадь содержит другие типы листов, кроме рабочих листов:

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

2-е РЕДАКТИРОВАНИЕ :

Я думаю, вы можете переписать HyperActive примерно так:

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

Затем в основной код Workbook_SheetFollowHyperlink добавьте следующую строку:

HyperActive rng:=nextWs.Range("A" & lastRow + 1)