Hallo EXCEL-Freunde,
habe mit Hilfe des Forums - weiss leider nicht mehr von wem - einen Code
angepasst, der eigentlich funktioniert. Ich muss aus der Spalte xy (Tabelle2)
die Werte mit einer Spalte xy (Tabelle1) vergleichen und in die Tabelle "Gefunden"
kopieren.
Der Code bringt mich aber zur Verzweiflung wenn z.B. in Tabelle2 in der ersten
zeile ein Blank ist oder wenn er bei bestimmten Suchvorgängen Leerzellen
findet. Teilweise muss ich EXCEl "abstürzen lassen" - also den code nicht unbedingt
verwenden.
Aber vielleicht kann jemand ein Problem erkennen oder man kann mit "OnError" o.ä.
das Ganze verbessern.
Sub amehrfach()
Application.ScreenUpdating = False
mySpalte = "C" ' = in Tabelle1 aus der die Zeilen kopiert werden
mySpalte2 = "B" ' = in Tabelle2, aus der in dieser Spalte die Werte gesucht werden
Set wks1 = Sheets("Tabelle1")
Set wks2 = Sheets("Tabelle2")
Set wksNeu = Sheets("Gefunden")
lng2 = IIf(IsEmpty(wks2.Cells(65536, mySpalte2)), wks2.Cells(65536, mySpalte2).End(xlUp).Row, 65536)
lngNeu = IIf(IsEmpty(wksNeu.Range("A65536")), wksNeu.Range("A65536").End(xlUp).Row + 1, 65536)
For lngRow = 1 To lng2
Set rng = wks1.Columns(mySpalte).Find(wks2.Cells(lngRow, mySpalte2), _
LookAt:=xlWhole, LookIn:=xlValues, after:=wks1.Cells(lngRow, mySpalte)) 'wks1.[A65536])
If Not rng Is Nothing Then
sFirst = rng.Address
rng.EntireRow.Copy wksNeu.Cells(lngNeu, 1)
lngNeu = lngNeu + 1
Do
Set rng = wks1.Columns(mySpalte).FindNext(after:=rng)
If Not rng Is Nothing Then
If sFirst = rng.Address Then Exit Do
rng.EntireRow.Copy wksNeu.Cells(lngNeu, 1)
lngNeu = lngNeu + 1
End If
Loop
End If
Next
Application.ScreenUpdating = True
End Sub

Code eingefügt mit: Excel Code Jeanie
Besten Dank für eine Hilfe!
mfg
Erich