Spalten vergleichen und kopieren
22.01.2009 20:43:26
edie
mit dem nachfolgenden Code wird die Spalte C mit der Spalte J verglichen, wobei in
der Spalte C der String nur einmal vorkommt in der Spalte J aber mehrfach.
Bei Übereinstimmung werden die Werte der Spalten K, L und M in die Spalten S, T und U
übernommen.
Sub t()
Dim wks As Worksheet
Dim vRow As Variant
Dim iRow As Integer, iRowL As Integer
Set wks = Worksheets("Tabelle1")
wks.Activate
iRowL = wks.Cells(Rows.Count, 1).End(xlUp).Row
For iRow = 3 To iRowL
vRow = Application.Match(wks.Cells(iRow, 2).Text, Columns(10), 0)
If Not IsError(vRow) Then
Cells(iRow, 19).Value = Cells(vRow, 10).Value
Cells(iRow, 20).Value = Cells(vRow, 11).Value
Cells(iRow, 21).Value = Cells(vRow, 12).Value
End If
Next iRow
End Sub
Leider wird immer nur eine bzw. die Erste Übereinstimmung kopiert wie kann ich erreichen, dass
alle Übereinstimmungen der Spalten C und J in die entsprechende Spalten kopiert werden?
Kann mir jemand dabei helfen?
Vielen Dank im Voraus.
Grüße