Da hast du Recht, hatte ich nicht dran gedacht! Problem bleibt aber weiterhin, dass du bei jedem Durchlauf in Spalte A bei OTA von neuem anfängst und dann auch immer an der selben Stelle den Treffer hast, wie beim ersten Treffer. Mit find und findnext könntest du dir immer den nächsten Treffer anzeigen lassen (also die Zelle des Treffers aus der du dann die Reihe/Spalte extrahierst). Bei deiner Variante müsstest du bei einem Treffer auf für den nächsten Durchlauf auf diesen Anfangswert setzen lassen. In Spalte A von OTA kommen die Werte ja auch nur so oft wie in BS vor. Habe mal einen Versuch gemacht. Dabei wird der Nachfolgeindex von i bei einem Treffer zwischengespeichert und alle Suchen starten dann ab dem Wert. Beim nächsten Treffer wird der wieder gespeichert. Name ist neui. Damit wird der selbe Treffer nicht nochmal angesprochen. Zudem sollte die I Schleife bei einem Treffer scho vorzeitig beendet werden. Gibt doch hoffentlich pro z nur einen Treffer?! Falls auch je z mehrere Treffer möglich sind, das exit do wieder rausnehmen. Gruß
Dim i As Integer
Dim wbOTA As Workbook
Dim wsOTA As Worksheet
Dim wsBS As Worksheet
Sub CopyBS()
Dim neui
Set wbOTA = ThisWorkbook
Set wsOTA = wbOTA.Worksheets("OTA")
Set wsBS = wbOTA.Worksheets("BS")
neui = 4
i = 4
z = 3
Do While z < 600
Do While i < 200
If wsOTA.Cells(i, 1).Value = wsBS.Cells(z, 6).Value Then
wsOTA.Cells(i, 2).Value = wsBS.Cells(z, 9).Value
wsOTA.Cells(i, 3).Value = wsBS.Cells(z, 7).Value
wsOTA.Cells(i, 4).Value = wsBS.Cells(z, 12).Value
wsOTA.Cells(i, 6).Value = wsBS.Cells(z, 19).Value
wsOTA.Cells(i, 7).Value = wsBS.Cells(z, 20).Value
wsOTA.Cells(i, 8).Value = wsBS.Cells(z, 21).Value
wsOTA.Cells(i, 9).Value = wsBS.Cells(z, 22).Value
wsOTA.Cells(i, 12).Value = wsBS.Cells(z, 23).Value
wsOTA.Cells(i, 14).Value = wsBS.Cells(z, 24).Value
wsOTA.Cells(i, 15).Value = wsBS.Cells(z, 25).Value
wsOTA.Cells(i, 16).Value = wsBS.Cells(z, 26).Value
neui = i + 1
Exit Do
End If
i = i + 1
Loop
i = neui
z = z + 1
Loop
|