cells.find per Makro

Cells.Find(What:=Windows("dc Bulling 2003.xls").ActiveCell.Text, After:=ActiveCell, _
LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate

Wenn jetzt aber das Kriterium nicht gefunden wird, bricht er ab und bringt mir einen Fehler.
Mit On Error Resume Next bringt mir auch nicht viel, da ich das Ergebnis, welches ich suchen hab lassen kopiere und wo anders einfüge.
Auf jeden Fall, wenn ich es mit On Error Resume Next löse, kopiert es mir irgendwas.

Wie kann ich es lösen, das er wenn es nicht vorhanden ist, einfach wieder von vorne anfängt und sich das nächste Kriterium holt.

Zur Vervollständigung hier der ganze Teil, aber nur der Suchroutine.

For J = 1 To 100 Step 2
Windows("dc Bulling 2003.xls").Activate
Range("B1").Select
ActiveCell.Offset(J, 0).Select
activej = ActiveCell.Text
Windows("dc 2002.xls").Activate
cJ = Cells.Find(What:=Windows("dc Bulling 2003.xls").ActiveCell.Text, After:=ActiveCell, _
LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
On Error Resume Next
ActiveCell.Offset(0, 8).Select
Selection.Copy
Windows("dc Bulling 2003.xls").Activate
Range("J2").Select
ActiveCell.Offset(J, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(1, -9).Select
teilenrJ = ActiveCell.Text
ActiveCell.Offset(0, 1).Select
IdentnrJ = ActiveCell.Text
If teilenrJ = "" And IdentnrJ = "" Then
Exit For
End If
Next J

Ich hoff mir kann jemand helfen.
Danke im vorraus.
Andy.