Clever-Excel-Forum - Hyperlink auf Tabellenblatt

Hallo Zusammen,

Mühsam ernährt sich das Eichhörnchen. Nachdem ich schon einigen Support hier im Forum erhalten habe, stehe ich mal wieder wie der Esel am Berg.
Mr. Google zeigte mir viele Beispiele, aber keines, welches ich erfolgreich adaptieren konnte.

Aus einer Liste erstelle ich automatisch Tabellenblätter, was Dank Hilfe von "Frogger1986" auch wunderbar klappt.
Zusätzlich wird der Tabellenblattnamen in einer Liste nachgeführt, was auch funktioniert, wenn auch eher schlecht umgesetzt von mir, siehe unten in grün.
Leider kriege ich es aber nicht hin, in dieser Liste den Hyperlink auf das Tabellenblatt zu legen.

Irgend jemand eine Idee wie der korrekte Syntax ist für die beiden Zeilen unten in rot?
Zum Testen das xls im Anhang.

Bin für jeden Tipp dankbar.
Grüsse Pean

Sub Kundenliste()
'
Dim i As Integer
Dim Last As Long
Dim sheet As Worksheet

Last = ThisWorkbook.Sheets("Liste").Cells(Rows.Count, 1).End(xlUp).Row 'Letzte benutzte Zeile im Bereich

On Error GoTo ErrExit

GetMoreSpeed

For i = 4 To Last
If ThisWorkbook.Sheets("Liste").Cells(i, 2).Value = Worksheets("Liste").Cells(1, 2).Value And (ThisWorkbook.Sheets("Liste").Cells(i, 3).Value > 0 Or ThisWorkbook.Sheets("Liste").Cells(i, 4).Value > 0) Then
SH = False
For Each sheet In ThisWorkbook.Sheets
If sheet.Name = ThisWorkbook.Sheets("Liste").Cells(i, 1).Value Then
SH = True
Exit For
End If
Next
If SH = False Then
ThisWorkbook.Sheets("Muster").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
With ThisWorkbook.Worksheets(Sheets.Count)
.Name = ThisWorkbook.Sheets("Liste").Cells(i, 1).Value
.Cells(2, 1) = ThisWorkbook.Sheets("Liste").Cells(i, 1).Value
.Cells(1, 2).Value = ThisWorkbook.Sheets("Liste").Cells(i, 2).Value
End With
Sheets("Kundenliste").Select
Range("A8").Select
Selection.End(xlDown).Select
ActiveCell.Cells(2, 1).Select
ActiveCell.Value = ThisWorkbook.Sheets("Liste").Cells(i, 1).Value
' ActiveCell.Value = Kundennummer'
' ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & Kundennummer & "'!A1", TextToDisplay:=Kundennummer '
End If
End If
Next

ErrExit:
GetMoreSpeed 0
End Sub

Sub GetMoreSpeed(Optional ByVal Modus As Integer = 1)
Static lngCalc As Long

With Application
If Modus = 1 Then
lngCalc = .Calculation
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = -4135
' .Cursor = xlWait
Else
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = IIf(lngCalc <> 0, lngCalc, -4105)
' .Cursor = xlDefault
End If
End With

End Sub

Grün:

Sheets("Kundenliste").Range("A8").End(xlDown).Cells(2, 1) = ThisWorkbook.Sheets("Liste").Cells(i, 1).Value

SH und Kundennummer sind nicht deklariert.

Was ist Kundennummer? Sollte man festlegen.

Hallo Raoul,

Vielen Dank, damit konnte ich schon den ersten Teil besser umsetzen. Habe nun auch "Kundennummer" noch deklariert, aber das Einfügen des Hyperlink funktioniert trotzdem nicht. Kriege es nicht hin, das der eingefügte Wert auf das Tabellenblatt zeigt.

Noch eine Idee dazu?

Besten Dank
Pean

Sub Kundenliste()
'
Dim i As Integer
Dim Last As Long
Dim sheet As Worksheet
Dim Kundennummer As Integer
Dim SH As Integer

Last = ThisWorkbook.Sheets("Liste").Cells(Rows.Count, 1).End(xlUp).Row 'Letzte benutzte Zeile im Bereich

On Error GoTo ErrExit

GetMoreSpeed

For i = 4 To Last
If ThisWorkbook.Sheets("Liste").Cells(i, 2).Value = Worksheets("Liste").Cells(1, 2).Value And (ThisWorkbook.Sheets("Liste").Cells(i, 3).Value > 0 Or ThisWorkbook.Sheets("Liste").Cells(i, 4).Value > 0) Then
SH = False
For Each sheet In ThisWorkbook.Sheets
If sheet.Name = ThisWorkbook.Sheets("Liste").Cells(i, 1).Value Then
SH = True
Exit For
End If
Next
If SH = False Then
ThisWorkbook.Sheets("Muster").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
With ThisWorkbook.Worksheets(Sheets.Count)
   .Name = ThisWorkbook.Sheets("Liste").Cells(i, 1).Value
   .Cells(2, 1) = ThisWorkbook.Sheets("Liste").Cells(i, 1).Value
       End With
Sheets("Kundenliste").Range("A8").End(xlDown).Cells(2, 1) = ThisWorkbook.Sheets("Liste").Cells(i, 1).Value
Sheets("Kundenliste").Range("A8").End(xlDown).Cells(1, 1) = Kundennummer
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & Kundennummer & "'!A1", TextToDisplay:=Kundennummer
End If
End If
Next

Hallo Pean,

Raoul21 schrieb:

Zitat:Was ist Kundennummer? Sollte man festlegen.

Die fehlende Deklaration sprach er eine Zeile vorher an!

Kundennummer ist und bleibt in Deinem Code weiterhin 0 (Null)!

Gruß Uwe

Halllo Kuwer,

Danke für dein Feedback.

Korrekt, der Wert gibt immer 0, das sehe sehe ich schon auch, wenn ich das Makro step bei step ausführe.
Wieso übernimmt "Kundennummer" nicht den vorher eingefügten Wert der Zelle?
Mit Sheets("Kundenliste").Range("A8").End(xlDown).Cells(1, 1) müsste doch der Wert der letzten Zelle dieser Spalte übernommen werden.

Sheets("Kundenliste").Range("A8").End(xlDown).Cells(1, 1) = Kundennummer

Für einen Profi vermutlich eine blöde Frage, für mich gerade ein Rätsel.

Grüsse
Pean

Problemstellung ebenfalls gepostet hier: https://www.ms-office-forum.net/forum/sh...?p=1977303&posted=1#post1977303

Hallo Pean,

wenn Kundennummer etwas zugewiesen werden soll, müsste es auf der linken Seite der Gleichung stehen. Wink

Hier mal eine Komplettlösung mit Hyperlink hin und wieder zurück:

Code:
Sub Kundenliste_Kuwer()

    Dim i As Long

    Dim Last As Long

    Dim sheet As Worksheet

    Dim Kundennummer As String

    Dim SH As Boolean

    Last = ThisWorkbook.Sheets("Liste").Cells(Rows.Count, 1).End(xlUp).Row 'Letzte benutzte Zeile im Bereich

    'GetMoreSpeed

    For i = 4 To Last

      Kundennummer = ThisWorkbook.Sheets("Liste").Cells(i, 1).Value

      If ThisWorkbook.Sheets("Liste").Cells(i, 2).Value = Worksheets("Liste").Cells(1, 2).Value And (ThisWorkbook.Sheets("Liste").Cells(i, 3).Value > 0 Or ThisWorkbook.Sheets("Liste").Cells(i, 4).Value > 0) Then

        SH = False

        For Each sheet In ThisWorkbook.Sheets

          If sheet.Name = Kundennummer Then

            SH = True

            Exit For

          End If

        Next

        If SH = False Then

          ThisWorkbook.Sheets("Muster").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

          ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Kundennummer

          With ThisWorkbook.Worksheets("Kundenliste").ListObjects("Tabelle2")

            .Parent.Hyperlinks.Add _

              Anchor:=.Range(1, 1).Offset(.ListRows.Count + 1, 0), Address:="", _

              SubAddress:="'" & Kundennummer & "'!A1", _

              TextToDisplay:=Kundennummer

            ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Hyperlinks.Add _

              Anchor:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Cells(2, 1), Address:="", _

              SubAddress:=.Range(1, 1).Offset(.ListRows.Count, 0).Address(External:=True), _

              TextToDisplay:=Kundennummer

          End With

        End If

      End If

    Next

End Sub

Gruß Uwe

Hallo Kuwer,

Vielen Dank für deine Lösung. Damit bin ich schon mal einen Schritt weiter, bezüglich meines Problemes.

Die Tabellenblätter und der Link zurück werden korrekt erstellt.

Jedoch wird in der "Kundenliste" jeweils nur der erste Eintrag gemacht und der Hyperlink wird durch die Schlaufe überschrieben.

Bild zur "Kundenliste" siehe Beilage

Was muss ich ändern, damit er auf die nächste Zeile springt und die Tabelle fortführt?

btw. auf deine Lösung wäre ich so gar nie gekommen. Verstehe auch nicht alles, selbst wenn es schwarz auf weiss vor mir steht. Hut ab.

Grüsse

Pean

Hallo Pean,

kann ich in Deiner Beispieldatei nicht nachvollziehen. Huh

[attachment=30994]

Gruß Uwe

Hallo Kuwer,

Habe das Problem gefunden, es liegt an meiner Excel 2016 Installation. Hier scheint irgend etwas zu klemmen.
Mit anderer Excel Version (2010) oder mit anderem PC und Excel 2016 funktioniert es.

Du hast mir jedenfalls mega geholfen...auf deiner Lösung sollte ich weiter aufbauen können.
Super Sache, vielen Dank.

Grüsse,
Pean