Teil von Hyperlinks ausgeben

Hallo an alle,
ich hoffe ihr könnt mir helfen.
Hänge mal eine Beispieltabelle an.
Wäret ihr so nett und helft mir mit einem Makro aus.
Es geht mir darum, wenn ihr euch die Tabelle 1 anguckt, die Zeilen, die mit Season anfangen, haben alle einen Hyperlink.
Ich nehme jetzt mal als Beispiel den ersten Hyperlink
http://www.imdb.com/title/tt2741110/
für den Teil tt2741110 habe ich eine Liste in Tabelle2
Also wäre es schön, wenn das Makro diese 9 Hyperlink-Teile zu den bereits in Tabelle2 bestehenden Teilen am Ende hinzufügt, Tabelle2 dann nach Spalte A aufsteigend sortiert und Tabelle1 komplett wieder leert, also auch die Bilder.
Die anderen Hyperlinks in Tabelle1 sind uninteressant, es geht nur um die Zeilen die mit Season anfangen.
Die Seite ist jetzt nur ein Beispiel, es kann auch sein, dass es mal Serien betrifft, die 10000 + Episoden haben.
Kann mir da jemand helfen?
https://www.herber.de/bbs/user/92420.xlsx
Gruß
Christian

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub aa() Dim hl As Hyperlink, s, ttd For Each hl In Sheets(1).Hyperlinks On Error Resume Next ttd = hl.TextToDisplay On Error GoTo 0 If ttd Like ("Season*") Then s = Split(hl.Address, "/") s = s(UBound(s) + (s(UBound(s)) = "")) Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1) = s End If Next End Sub

Sub aa() Dim hl As Hyperlink, s, ttd For Each hl In Sheets(1).Hyperlinks On Error Resume Next ttd = hl.TextToDisplay On Error GoTo 0 If ttd Like ("Season*") Then s = Split(hl.Address, "/") s = s(UBound(s) + (s(UBound(s)) = "")) With Sheets(2).Cells(Rows.Count, 1).End(xlUp) .Offset(1) = s .Offset(1, 1) = hl.Parent.Offset(2) End With End If Next With Sheets(2) .Range("A1").Sort key1 = .Range("A1"), order1:=xlAscending, Header:=xlNo End With With Sheets(1) .Cells.Clear .DrawingObjects.Delete End With End Sub

Sub aa() Dim hl As Hyperlink, s, ttd For Each hl In Sheets(1).Hyperlinks On Error Resume Next ttd = hl.TextToDisplay On Error GoTo 0 If ttd Like ("Season*") Then s = Split(hl.Address, "/") s = s(UBound(s) + (s(UBound(s)) = "")) With Sheets(2).Cells(Rows.Count, 1).End(xlUp) .Offset(1) = s .Offset(1, 2) = hl.Parent.Offset(2) End With End If Next With Sheets(2) .Range("A:B").Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlNo End With With Sheets(1) .Cells.Clear .DrawingObjects.Delete End With End Sub

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread