Excel vba Daten kopieren wenn Bedingung erfüllt
21.05.2015 13:40:22
Crizz
ich arbeute an einem Makro der Daten von einem Tabellenblatt ins andere kopieren soll mit der Bedingung das vier Felder auf Ungleichheit geprüft werden sollen. Sind die Felder vom Tabellenblatt "Datenblatt" nicht gleich den vom Tabellenblatt "MBC" soll die ganze Zeile von "Datenblatt" nach "MBC" in die nächst freie Zeile kopiert werden.
Mein Code hierfür sieht folgendermaßen aus:
Sub Aktualisieren()
Dim eintragCheck1 As Variant
Dim eintragCheck2 As Variant
Dim eintragCheck3 As Variant
Dim eintragCheck4 As Variant
Dim eintragCheck10 As Variant
Dim eintragCheck20 As Variant
Dim eintragCheck30 As Variant
Dim eintragCheck40 As Variant
Dim leereZeile
Application.ScreenUpdating = False
For Zähler = 4 To Sheets("Datenblatt").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Datenblatt").Range("A" & Zähler, "L" & Zähler).Copy
Sheets("MBC").Activate
For j = 4 To Sheets("MBC").Cells(Rows.Count, 7).End(xlUp).Row
eintragCheck10 = Sheets("MBC").Cells(j, 2).Value
eintragCheck20 = Sheets("MBC").Cells(j, 5).Value
eintragCheck30 = Sheets("MBC").Cells(j, 6).Value
eintragCheck40 = Sheets("MBC").Cells(j, 7).Value
For i = 4 To Sheets("Datenblatt").Cells(Rows.Count, 7).End(xlUp).Row
eintragCheck1 = Sheets("Datenblatt").Cells(i, 2).Value
eintragCheck2 = Sheets("Datenblatt").Cells(i, 5).Value
eintragCheck3 = Sheets("Datenblatt").Cells(i, 6).Value
eintragCheck4 = Sheets("Datenblatt").Cells(i, 7).Value
If eintragCheck1 eintragCheck10 And eintragCheck2 _
eintragCheck20 And eintragCheck3 eintragCheck30 And eintragCheck4 eintragCheck40 Then
leereZeile = Sheets("MBC").Cells(Rows.Count, 7).End(xlUp).Row + 1
Sheets("MBC").Range("A" & leereZeile).PasteSpecial Paste:= _
xlPasteFormulasAndNumberFormats
End If
Next i
Next j
Next Zähler
End Sub
Das Problem dabei ist es wird nur eine Zeile kopiert und dann funktioniert nichts mehr. Hoffe ihr könnt mir weiiterhelfen.
Grüße Chris