Hallo Herr Gnädinger,
hier mein Lösungvorschlag evtl. ist es schon zu spät. Aber antworten ist in diesem Forum Ehrensache.
ub Namen()
Dim i As Integer
Dim x As Integer
Dim a As String
Dim b As String
Dim letzte As Integer
Dim adres As Range
'alte Ergebnisse löschen
Worksheets(1).Select
Range(„A:B“).EntireColumn.ClearContents
Cells(1, 1).Activate
Worksheets(2).Select
Worksheets(2).Cells(1, 1).Select
'Zähler für Liste in Blatt1 setzen
x = 1
Worksheets(1).Select
'Anzahl zu prüfende Zeilen ermitteln
letzte = Tabelle1.Range(„H65536“).End(xlUp).Row
'Schleife setzen
For i = 1 To letzte
Worksheets(1).Activate
'Namen in Variable übernehmen
a = Cells(i, 8).Value
'Name in Blatt2 suchen
Worksheets(2).Activate
Cells.Find(what:=a, After:=ActiveCell, LookIn:=xlFormulas, lookat _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Select
'In Variable die Adresse des gefundenen Namen übernhmen
b = ActiveCell.Address
'Namen und Fundort in Blatt1 Spalte A und B eintragen
Worksheets(1).Activate
Cells(x, 1).Value = Worksheets(2).Range(b).Value
Cells(x, 2).Value = "Tabelle-2 " & b
'Zähler für Liste in Blatt1 um 1 erhöhen
x = x + 1
Next i
End Sub
Gruß Hugo