Sub HyperlinkErzeugen()
Dim StartSpalte As Long, EndSpalte As Long
Dim StartZeile As Long, EndZeile As Long
Dim zae1, zae2
On Error Resume Next
StartSpalte = 1 'Selection.Column
EndSpalte = 3 'StartSpalte + Selection.Columns.Count - 1
StartZeile = 1 'Selection.Row
EndZeile = 40 'StartZeile + Selection.Rows.Count - 1
For zae1 = StartSpalte To EndSpalte
For zae2 = StartZeile To EndZeile
With ActiveSheet
'If Not IsEmpty(.Cells(zae2, zae1)) Then
.Hyperlinks.Add Anchor:=.Cells(zae2, zae1), Address:="", _
ScreenTip:="HALLO", TextToDisplay:=.Cells(zae2, zae1).Text
'End If
End With
Next zae2
Next zae1
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveCell.Offset(-1).Hyperlinks.Delete
End Sub
Die Datei https://www.herber.de/bbs/user/71574.xls wurde aus Datenschutzgründen gelöscht