VBA: Vergleiche 2 Zellen, kopiere bei Übereinstimm
18.02.2016 09:50:59
Baiko
ich möchte in einer Tabelle (Arbeitsblatt "Seite1_1") die Werte der Zellen in Spalte 18 und 19 vergleichen, wobei nur die ersten 7 Stellen berücksichtigt werden sollen ("LINKS").
Stimmen diese überein, soll aus einem Tabellenblatt "Verweise" der Wert aus der Zelle 2, 2 in das Arbeitsblatt "Seite1_1" Spalte 16 kopiert und der Wert aus 2, 3 in Spalte 17 kopiert werden (und zwar in die Zeile, deren Werte zuvor verglichen worden sind. Stimmen sie nicht überein, soll kein Kopiervorgang erfolgen.
Das Makro soll alle Zeilen durchlaufen und den Prüf- bzw. Kopiervorgang bis zum Ende der Tabelle durchführen, soweit die Zeilen Daten enthalten.
Folgendes Makro funktioniert, jedoch habe ich hier zuvor manuell die Werte aus den Spalten 18 und 19 mit der Funktion "Links" auf 7 Stellen reduziert und das Ganze in die Spalten 34 und 35 übertragen. Auf diesen Umweg würde ich nun gern verzichten und den Vergleich einschließlich der Berücksichtigung nur der ersten 7 Stellen direkt in das Makro einbauen, indem direkt die Spalten 18 und 19 angesprochen werden.
Wer kann mir helfen? Danke im Voraus!!
Sub Test()
Dim rng As Range
For Each rng In Sheets("Seite1_1").Range(Cells(3, 34), Cells(Rows.Count, 1).End(xlUp))
If Sheets("Seite1_1").Cells(rng.Row, 34) = Sheets("Seite1_1").Cells(rng.Row, 35) Then
Sheets("Seite1_1").Cells(rng.Row, 37).Copy _
Sheets("Seite1_1").Cells(rng.Row, 16).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
If Sheets("Seite1_1").Cells(rng.Row, 34) = Sheets("Seite1_1").Cells(rng.Row, 35) Then
Sheets("Seite1_1").Cells(rng.Row, 38).Copy _
Sheets("Seite1_1").Cells(rng.Row, 17).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
Next rng
End Sub