Beiträge zum Thread: Hyperlink in Blattkopie aktualisieren

Hallo Uwe,

sollte man vielleicht schreiben wo die Hyperlinks sind?
Vielleicht sollte man auch schreiben was sich ändern sollte, in der neuen Tabelle?

Gruß Hubert

Hi,

Public Sub intern()

    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

hth
Ulf

Hallo,

falls ich es richtig verstanden habe so?

Option Explicit



Sub NewSheet()

    Dim oldwks As Worksheet, newWks As Worksheet, Name$, Zellen As Range

    Name = InputBox("Bitte Blattnamen vergeben", "Abfrage Blattnamen")

    Set oldwks = Tabelle6

    Set newWks = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))

    oldwks.Range("A1").CurrentRegion.Copy

    newWks.Range("A1").PasteSpecial (xlAll)

    With newWks

        Set Zellen = .Range("A1,J1,S1,AB1,AK1,AT1,BC1,BL1,BU1,CD1,CM1,CV1")

        .Name = Name

        .Hyperlinks.Add Anchor:=Zellen, Address:="", SubAddress:=.Name & "!DO1"

        Zellen.Interior.Color = RGB(146, 208, 80)

    End With

    With Zellen

        .Interior.Color = RGB(146, 208, 80)

        .HorizontalAlignment = xlCenter

    End With

End Sub

Gruß Uwe

Hallo
Habe andere Lösung gefunden, werde deinen Vorschlag trotzdem noch ausprobieren.
Erstmal herzlichen Dank und schönes Wochenende.
Gruß Uwe

Hallo
deine Lösung ist perfekt, und funktioniert einwandfrei.
Herzlichen Dank und schönes WE
Gruß Uwe

Hab doch noch eine Frage.
Ist es möglich, deinen Code per Hyperlink in jeder neuen Blattkopie zu starten?
Kann leider selbst zu wenig, um das hinzukriegen.
Herzlichen Dank im voraus.

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

Hallo
habe passende Lösung gefunden.
trotzdem herzlichen Dank
Doc Brown.

Sub M_snb()

  For Each it In Sheets(Sheets.Count).Hyperlinks

     st = Split(it.SubAddress, "!")

     If it.Address = "" Then st(0) = Replace("'~'", "~", it.Range.Parent.Name)

     it.SubAddress = Join(st, "!")

  Next

End Sub

Hallo Uwe, wenn die Hyperlinks beim Kopieren automatisch angepasst werden sollen, ist es meist besser, sie nicht als feste Zellverweise zu hinterlegen, sondern per Formel oder VBA dynamisch aufzubauen.

Bei normalen Hyperlinks kann Excel beim Kopieren zwar einiges automatisch anpassen, aber bei Blattnamen und wiederkehrenden Jahreskopien klappt das nicht immer zuverlässig. Eine VBA-Lösung wäre hier wahrscheinlich die sauberste Variante: Beim Erzeugen des neuen Jahresblatts einfach die Hyperlinks durchlaufen und die Zieladresse auf das aktuelle Blatt setzen.

Wichtig wäre noch, wie die Hyperlinks aktuell erstellt wurden (manuell eingefügt, Formel =HYPERLINK oder per Makro). Davon hängt die beste Lösung ab.

Hallo Paul
Habe für mich schon die perfekte Lösung, ( Vorschlag von ULF ) gefunden.
Hab seinen Code für die 1. Tabelle eingefügt, für die Ausführung ein Steuerelement zugefügt.
Also, Tabelle kopieren - umbenennen - Steuerelement anklicken --- hurra, alles klappt perfekt.
Trotzdem herzlichen Dank
Gruß Uwe