Hallo Leute,

ich habe leider mal wieder einen Kampf mit Excel gestartet den ich wieder zu verlieren scheine. :(

Ich möchte mehrere Zellen aus einer Zeile von einem Tabellenblat in das andere kopieren. Allerdings nicht irgendwelche, sondern lediglich dann, wenn das Suchkriterium "Vertragsnummer" übereinstimmt.
Mein problem ist allerdings, das dieses Suchkirterium mehrfach vorkommt.

Eigentlich soll das Makro bei z.B. 4 Übereinstimmungen (Vertragsnummer kommt in beiden Tabellenblättern immer gleich oft vor) jeweils die Zellen aus der 1. Zeile mit Übereinstimmung  in die eine Zeile im Zielblatt kopieren. Die Daten aus der 2. Übereinstimmung in die [u]DIE NÄCHSTE Zeile[/u] im Zielblatt usw.

Allerdings überschreibt mein Makro die bereits gefüllten Zellen in den Zeilen immer wieder. Ich weiß auch warum. Ich habe eine Doppelschleife eingebaut. Diese überpüft die Zellen jedes mal aufs neue auf Übereinstimmung der Vertragsnummer und fügt immer die "aktuellesten" (also als letztes gefundenen) Werte in die Zellen ein.
Deswegen habe ich am Ende in der Zieldatei 4 Zeilen voll mit den Daten aus der letzten gefundenen Übereinstimmung.

Mein Code sieht bisher wie folgt aus:

Option Explicit

Dim z As Integer
Dim i As Integer
Dim wbOTA As Workbook
Dim wsOTA As Worksheet
Dim wsBS As Worksheet

Sub CopyBS()


Set wbOTA = ThisWorkbook

Set wsOTA = wbOTA.Worksheets("OTA")
Set wsBS = wbOTA.Worksheets("BS")



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
                        
                 End If

            i = i + 1

            Loop
            
i = 4
z = z + 1

Loop

End Sub



Wenn jemand eine Idee hat wie ich das umgehen kann wäre das wunderbar.

Vielen Dank :)