Hyperlinks nach Vergleich kopieren...
20.08.2003 16:02:45
Daniel G
Ich habe mein grösstes Problem mit Hilfe des Makros aus Thread Nr.297234 gelöst(etwas geändert, trotzdem THX!!):
Private Sub Suchenundfinden_Click()
On Error Resume Next
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim WS3 As Worksheet
Dim Suche As String
Dim find As Variant
Dim I As Integer
Set WS1 = Worksheets("Tabelle1")
Set WS2 = Worksheets("Tabelle2")
Set WS3 = Worksheets("Tabelle3")
For I = 1 To 500 'Anzahl der Zeilen
Suche = WS2.Cells(I, 1) 'Suchbegriff aus Tabelle 2 / Spalte A
Set find = WS1.Range("A:A").find(Suche, LookIn:=xlValues) ' In Tabelle 1 / Spalte a suchen
WS2.Rows(find.Row).Format = WS1.Rows(I).Format ' wenn gefunden komplette Zeile von Tabelle 1 nach Tabelle 2 kopieren
Next I
End Sub
Tausend Dank an Alle, die hier im Forum arbeiten um Probleme zu lösen...
Gruss Daniel