Abbruch bei Suche ohne Ergebnis

Bin gerade auf dieses Forum gestoßen und hoffe das man mir helfen kann..
Zur Ausgangslage, ich habe 2 Listen mit einigen tausend einträgen Ziel wäre es alle Einträge aus Liste A in Liste B zu suchen
Sofern A in B gefunden wird, wird der Eintrag (nur eine Spalte --> 11) aus B in A zum betreffenden Eintrag kopiert
Wenn A in B nicht gefunden wird, soll der Eintrag aus A in einer Liste C gesammelt werden.
Variable: "Webportal" wäre A, "SES User" wäre B und "ohne SES" wäre C
Mein Code sieht folgendermaßen aus.. (bin leider etwas eingerostet...)


Dim s As Integer
Dim a As Integer
Dim suche As Range
s = 2
a = 1
Start:
ActiveSheet.Cells(s, 1).Select
Do Until ActiveCell.Value = ""
Sheets("Webportal").Activate
Set suche = ActiveSheet.Cells(s, 1)
Sheets("SES User").Activate
Columns("A:A").Select
On Error GoTo fehler
Selection.Find(What:=suche.Value, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
ActiveCell.Offset(0, 11).Select
Selection.Copy
Sheets("Webportal").Activate
ActiveSheet.Cells(s, 6).Select
ActiveSheet.Paste
s = s + 1
Loop
GoTo ende
fehler:
Sheets("Webportal").Activate
ActiveCell.EntireRow.Select
Selection.Copy
Sheets("ohne SES").Activate
ActiveSheet.Cells(a, 1).Select
ActiveSheet.Paste
a = a + 1
s = s + 1
Sheets("Webportal").Activate
GoTo Start
ende:

Mein Problem ist, dass sobald ein Eintrag aus A in B nicht gefunden wird ich den Fehler "91" bekomme und die Lösung "On Error GoTo fehler" die ich aus einem anderen Forum habe nicht funktioniert...
Ich finde nur meinen Denkfehler nicht....
Wäre sehr dankbar für Hilfe!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Suchen_kopieren() Dim suche As Range, rngGefunden As Range Dim s As Long, a As Long s = 2 a = 1 ActiveSheet.Cells(s, 1).Select 'ist eigenlich überflüssig Do Until Sheets("Webportal").Cells(s, 1).Value = "" Set suche = Sheets("Webportal").Cells(s, 1) Set rngGefunden = Sheets("SES User").Columns("A:A").Find(What:=suche.Value, _ After:=Sheets("SES User").Range("A1"), LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False) If rngGefunden Is Nothing Then Sheets("Webportal").Cells(s, 1).EntireRow.Copy Sheets("ohne SES").Cells(a, 1) a = a + 1 Else rngGefunden.Offset(0, 11).Copy Sheets("Webportal").Cells(s, 6) End If s = s + 1 Loop End Sub

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread