Vergleichen und Kopieren
23.10.2007 13:29:00
Klaus
ich habe einen 10spaltigen Wertebereich 1 (A1:J141) mit Spaltenüberschriften
und einen zu vergleichenden Bereich 2 (Q2:Z6722) mit den gleichen Überschriften
(Name 1 = StdPlanSpalte, Name 2 = StdPlanAlles).
Es sollen nun zeilenweise die Werte von (Bereich 1.Spalte B) verglichen werden mit den
Werten (Bereich 2.Spalte R). Bei Übereinstimmung sollen die Werte der Zeile aus dem Bereich 1
über die Fundstellen-Zeile von Bereich 2 kopiert werden. Das habe ich mit untenstehendem Makro
bereits gelöst. Jetzt meine Frage:
Wenn KEINE Übereinstimmung gefunden wird, soll die zu kopierende Zeile in die erste freie Zeile
im Bereich 2 kopiert werden. Kann mir da jemand von Euch helfen?
Beispielmappe anbei
https://www.herber.de/bbs/user/47014.xls
Für Antworten Dank im voraus
Klaus
Sub VergleichenKopieren()
Dim rng As Range
Dim iRow As Integer
iRow = 2
Do Until IsEmpty(Cells(iRow, 2))
Set rng = Worksheets("Archiv").Columns(18).Find( _
what:=Cells(iRow, 2), lookat:=xlWhole, LookIn:=xlValues)
If Not rng Is Nothing Then
Range(rng.Offset(0, -1), rng.Offset(0, 8)).Value = _
Range(Cells(iRow, 1), Cells(iRow, 11)).Value
End If
***wenn keine Fundstelle, dann Copy in 1. leere Zeile Bereich 2***
iRow = iRow + 1
Loop
End Sub
Anzeige