Zellenverlinkung in gleichem xls

Sub Verlinkung() Dim Kst$ Dim wks1 As Excel.Worksheet Dim wks As Excel.Worksheet Dim zeile1 As Integer Kst$ = Sheets("TopLevelView").Cells(ActiveCell.Row, 1) Set wks = ThisWorkbook.Worksheets("TopLevelView") Set wks1 = ThisWorkbook.Worksheets("DetailedView") zeile_end_new1 = wks1.Cells(Rows.Count, 1).End(xlUp).Row wks1.Activate For zeile1 = 6 To zeile_end_new1 If wks1.Cells(zeile1, 1).Value = Kst$ Then End If Next wks.Activate ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _ "DetailedView!" & wks1.Cells(zeile1, 1).Address & ", TextToDisplay:= " & wks1.Cells( _ zeile1, 1).Value End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
erstmal danke an Rudi, das Problem mit der Verlinkung ist fast gelöst. Nun gibt es folgendes Problem noch:
Nicht jede Zelle aus Sheet1 ist auch auf dem Sheet2. Die Zellen die eben nicht vorhanden sind, sollen abgefangen und übersprungen werden.
In Sheet1 sind in der 2. Spalte alle Zellen, die nicht in Sheet2 vorhanden sind, leer.


Sub Verlinkung_new()
Application.ScreenUpdating = False
Dim Kst$, Kst1
Dim wks1 As Excel.Worksheet
Dim wks As Excel.Worksheet
Dim zeile1, zeile2 As Integer
Dim zeile As Integer
Dim zeile_end_new1, zeile_end_new  As Integer
Kst$ = Sheets("TopLevelView").Cells(ActiveCell.Row, 1)
Set wks = ThisWorkbook.Worksheets("TopLevelView")
Set wks1 = ThisWorkbook.Worksheets("DetailedView")
zeile_end_new = wks.Cells(Rows.Count, 1).End(xlUp).Row
zeile_end_new1 = wks1.Cells(Rows.Count, 1).End(xlUp).Row
With wks
For zeile1 = 8 To zeile_end_new
Kst1 = wks.Cells(zeile1, 1).Value
Cells(zeile1, 1).Select
With wks1
For zeile2 = 7 To zeile_end_new1
If wks1.Cells(zeile2, 1).Value = Kst1 Then
zeile = zeile2
End If
Next zeile2
End With
If zeile = 0 Then
GoTo weiter
Else
On Error Resume Next
wks.Hyperlinks.Add Anchor:=Selection, Address:= _
"#DetailedView!" & wks1.Cells(zeile, 1).Address
On Error GoTo 0
End If
weiter: Next zeile1
End With
Application.ScreenUpdating = True
End Sub

Kann mir jemand´den Fehler nennen? Danke im voraus,
Filiz

Sub Verlinkung_new() Application.ScreenUpdating = False Dim Kst$, Kst1 Dim wks1 As Excel.Worksheet Dim wks As Excel.Worksheet Dim zeile1, zeile2 As Integer Dim zeile As Integer Dim zeile_end_new1, zeile_end_new As Integer Kst$ = Sheets("TopLevelView").Cells(ActiveCell.Row, 1) Set wks = ThisWorkbook.Worksheets("TopLevelView") Set wks1 = ThisWorkbook.Worksheets("DetailedView") zeile_end_new = wks.Cells(Rows.Count, 1).End(xlUp).Row zeile_end_new1 = wks1.Cells(Rows.Count, 1).End(xlUp).Row With wks For zeile1 = 8 To zeile_end_new Kst1 = wks.Cells(zeile1, 1).Value Cells(zeile1, 1).Select With wks1 For zeile2 = 7 To zeile_end_new1 If wks1.Cells(zeile2, 1).Value = Kst1 Then zeile = zeile2 End If Next zeile2 End With If zeile = 0 Then GoTo weiter Else On Error Resume Next wks.Hyperlinks.Add Anchor:=Selection, Address:= _ "#DetailedView!" & wks1.Cells(zeile, 1).Address On Error GoTo 0 End If weiter: Next zeile1 End With Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread