Komplette Zeile kopieren wenn ZWEI Zellen nicht leer

[co-pilot]

Hallo zusammen!!
Das nachfolgende Makro habe ich in Verwendung, welches bei Eingabe eines Wertes in die Spalte "D" die jeweilige ganze Zeile vom Datenblatt "Aktuell" ins Datenblatt "Archiv" kopiert.
Funktioniert soweit auch alles prima! Mein Problem ist jetzt nur, dass ich gerne hätte, dass die Zeile erst "verschoben" wird, wenn auch in der Spalte "C" der gleichen Zeile ein Wert eingegeben wurde. Also in Spalte "C" UND "D" einer Zeile soll ein Wert stehen und erst dann soll die Zeile "verschoben" werden. Wenn nur in "C" oder nur in "D" einer Zeile ein Wert steht, soll die Zeile noch nicht verschoben werden...

Hier mein aktuelles Makro:

Private Sub worksheet_change(ByVal target As Range)

If Not Intersect(target, Range("D4:D" & Cells(Rows.Count, "D").End(xlUp).Row)) Is Nothing And target.Count = 1 Then
  If target > 0 Then
    With Sheets("Archiv")
      Range(Cells(target.Row, "A"), Cells(target.Row, "E")).Copy
        .Range("A" & .Cells(Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial Paste:=xlValues
      Cells(target.Row, "E").Copy
        .Range("E" & .Cells(Rows.Count, "A").End(xlUp).Row).PasteSpecial Paste:=xlValues
      Application.CutCopyMode = False
    End With
    With Sheets("Aktuell")
      Range(Cells(target.Row, "A"), Cells(target.Row, "E")).Delete
    End With
End If
End If
End Sub

Ich grübele nun schon den ganzen Tag über diesem "Problem"... und wahrscheinlich ist es wieder einfach als man denkt... 
Kann mir bitte jemand helfen?
Vielen Dank schonmal!
Beste Grüße,
co-pilot

[volti]

Hallo,

hier mal eine (ungetestete) Idee...
Wird auf leer geprüft, wenn nicht gewünscht auf .value>0 abändern!

Code:

Private Sub worksheet_change(ByVal target As Range)

  With target
    If .row > 3 And .Count = 1 Then      ' Wert in aktuelle Zelle und erst ab Zeile 4
      Select Case .Column
      Case 4: If IsEmpty(.Offset(0, 1)) Then Exit Sub
      Case 5: If IsEmpty(.Offset(0, -1)) Then Exit Sub
      Case Else: Exit Sub
      End Select
      
      With Sheets("Archiv")
            Range(Cells(target.row, "A"), Cells(target.row, "E")).Copy
            .Range("A" & .Cells(Rows.Count, "A").End(xlUp).row + 1).PasteSpecial Paste:=xlValues
            Cells(target.row, "E").Copy
            .Range("E" & .Cells(Rows.Count, "A").End(xlUp).row).PasteSpecial Paste:=xlValues
            Application.CutCopyMode = False
       End With
       With Sheets("Aktuell")
            Range(Cells(target.row, "A"), Cells(target.row, "E")).Delete
      End With
    
    End If
  End With
End Sub

_________
viele Grüße
Karl-Heinz

[co-pilot]

Hallo volti...

...und vielen Dank für die super-schnelle Rückmeldung und für deinen Programmier-Vorschlag!!!
Allerdings funktioniert das momentan leider so noch nicht.
Die Zelle wird jetzt gar nicht mehr verschoben, egal ob in Spalte "C" oder "D" oder in beiden ein Wert steht... 

Viele Grüße,
Andre

[volti]

Hallo,

ich hatte mich wohl verlesen und D und E genommen. s. Case 4 und 5.

Code:

Private Sub worksheet_change(ByVal target As Range)

  With target
    If .row > 3 And .Count = 1 Then      ' Wert in aktuelle Zelle und erst ab Zeile 4
      Select Case .Column
      Case 3: If IsEmpty(.Offset(0, 1)) Then Exit Sub
      Case 4: If IsEmpty(.Offset(0, -1)) Then Exit Sub
      Case Else: Exit Sub
      End Select
      
      With Sheets("Archiv")
            Range(Cells(target.row, "A"), Cells(target.row, "E")).Copy
            .Range("A" & .Cells(Rows.Count, "A").End(xlUp).row + 1).PasteSpecial Paste:=xlValues
            Cells(target.row, "E").Copy
            .Range("E" & .Cells(Rows.Count, "A").End(xlUp).row).PasteSpecial Paste:=xlValues
            Application.CutCopyMode = False
       End With
       With Sheets("Aktuell")
            Range(Cells(target.row, "A"), Cells(target.row, "E")).Delete
      End With
    
    End If
  End With
End Sub

_________
viele Grüße
Karl-Heinz

[co-pilot]

Jetzt FUNKTIONIERT´s!!!
Prima, ganz herzlichen Dank für die Mühen!!
Gruß,
Andre