Forumbeitrag
Excel-Version des Fragestellers:
2022
Erfahrungslevel des Fragestellers:
Basiskenntnisse in Excel
Hi,
so sollte das beim Neuerstellen aus einem Blatt funktioniern
Diese Arbeitsmappe
Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim hl As Hyperlink
If Sh.Hyperlinks.Count = 0 Then
Exit Sub
Else
Set hl = Sh.Hyperlinks(1)
If Left(Replace(CStr(hl.SubAddress), Sh.Name, ""), 2) = "''" Then
'Nix
Else
Call intern(Sh)
End If
End If
End Sub
Modul
Option Explicit
Public Sub intern(wks As Worksheet)
Dim wb As Workbook
'Dim wks As Worksheet
Dim hls As Hyperlinks
Dim hl As Hyperlink
Set wb = ThisWorkbook
'Set wks = wb.Worksheets(wb.Worksheets.Count)
Set hls = wks.Hyperlinks
For Each hl In hls
If hl.Address = "" Then
hl.SubAddress = "'" & wks.Name & "'!" & Right(hl.SubAddress, Len(hl.SubAddress) - InStr(hl.SubAddress, "!"))
End If
Next
End Sub
in deiner Mappe
https://www.herber.de/bbs/user/180901.xlsm
hth
Ulf