ich hatte schon einmal diese Frage eingestellt, aber irgendwie
habe ich mich nicht sonderlich gut ausgedrückt. Deswegen, und mit neuem Mut,
noch einmal.
Siehe hierzu bitte den Link.
https://www.herber.de/bbs/user/38499.xls
Danke
Wolfgang
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'Linke Nachbarzelle nach Adresse des Hyperlinks Kopieren und Zellen nach rechts verschieben
If Not Intersect(Target, Me.Range("E:E")) Is Nothing And Target.Cells.Count = 1 Then
If Target.Hyperlinks.Count > 0 Then
If MsgBox("History kopieren?", vbYesNo + vbDefaultButton2) = vbYes Then
Zieltabelle = Mid(Target.Hyperlinks(1).SubAddress, 1, InStr(1, Target.Hyperlinks(1).SubAddress, "!") - 1)
ZielZelle = Mid(Target.Hyperlinks(1).SubAddress, InStr(1, Target.Hyperlinks(1).SubAddress, "!") + 1)
Target.Offset(0, -1).Copy
Worksheets(Zieltabelle).Range(ZielZelle).Insert Shift:=xlToRight
Application.CutCopyMode = False
End If
End If
End If
End Sub