Bedingung bei Verschiebung von Zellinhalten

Question

Hallo liebe Exelgemeinde
Ich habe hier eine Tabelle, bei der Exel nicht das macht, was ich eigentlich erwarte.
Es werden Zellen von A8 bis J8 ausgefüllt. Hierbei bleiben zunächst die Zellen F8 und G8 leer.
Nachdem dann später in beiden Zellen ein Betrag eingegeben wurde, werden die Werte der Zellen A8 bis J8 auf ein zweites Tabellenblatt verschoben. In meiner Tabelle funktioniert das auch tadellos, wenn zuerst ein Wert in Zelle F8 eingegeben wird. Bei Eingabe in Zelle G8 überträgt Exel die Zeile sofort auf das andere Tabellenblatt.
Also, die Bedingung müßte zum Verschieben auf BEIDE Zellen ausgeweitet werden, wobei es unerheblich ist, welche Zelle zuerst einen Wert erhält.
Ich hoffe, ich habe mich klar genug ausgedrückt, um Hilfe zu bekommen.
Mit vielen Dank im Voraus

Gruß ACR

PS: Zur Veranschaulichung habe ich eine Tabelle, die bei Bedarf geschickt wird.

Answer 1

Hallo,

was für eine Formel oder Angabe hast du in dem 2.Tabellenblatt in dem beiden Zellen stehen, ich vermute dort den Fehler.

Gruß

Helmut

Answer 2

Hallo Helmut
Nur auf Blatt 1 werden Eingaben gemacht. Wie ich schon schilderte, wird die gesamte Zeile nach Ausfüllung der BEIDEN Zellen F8 und G8 auf das 2. Tabellenblatt verschoben.
Wenn nur eine Zelle ausgefüllt ist, soll der Verschiebungsvorgang NICHT durchgeführt werden.
Diese Funktion funktioniert auch, allerdings nur, wenn zuerst die Zelle F8 ausgefüllt wird. Ich kann Dir zum besseren Verständnis mal meine Tabelle zukommen lassen (Nur wohin laden????) .
Gruß ACR

Answer 3

Hallo,

kannst du hier hin laden

npshare.de/

und den Link hier hinterlegen

Gruß

Helmut

Answer 4

Hallo ACR,

Diese Funktion funktioniert auch

.... bitte welche Funktion?

Wenn es keine Tabellenfunktion ist, dann müsstest Du uns mal den VBA-Code nennen, der die Verschiebung bewerkstelligt.

Gruß
Rainer

Answer 5

Hallo Helmut, hallo Rainer...
Ich habe die Datei hochgeladen. Ihr könnt sie Euch ja mal runterladen und anhand der Datei mein Problem überprüfen. Die Datei hat bereits einen VBA-Code der wohl nicht in meinem Sinne funktioniert.
In Tabelle 1 wird diese Funktion aufgerufen. Es sollte aber nach Möglichkeit hier eine Erweiterung hinzukommen. Eine Verschiebung sollte erst dann stattfinden, wenn alle Bedingungen (Ausfüllen der entsprenden Zellen mit Daten) in den folgenden Zellen erfüllt sind: F8, G8, I8 und J8

Vielleicht könnt Ihr mir ja helfen. Die Tabell ist sonst selbsterklärend.

Gruß ACR

Answer 6

Hallo noch mal...
Habe den Downloadlink vergessen. Hier ist er:
http://npshare.de/files/631ec668/Abrechnung.xls

Gruß ACR

Answer 7

Hallo nochmal
Wenn das Herunterladen meiner Exeltabelle nicht gewünscht wird, hier das VBA-Macro, daß das Verschieben einer Zeile duchführt.
Das Macro soll aber prüfen, ob folgende Zellen ausgefüllt sind, bevor der Kopiervorgang gestartet wird:
F8, G8, I8 und J8.
Sollte allerdings eine der angeführten Zellen leer sein, soll der Kopiervorgang NICHT durchgeführt werden
Bitte um Hilfe, wie das geänderte werden kann.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim loZeile As Long
Dim Sh As Worksheet
Dim chk As Boolean

loZeile = Target.Row

'--- Prüfungen------
If Target.Column <> 7 Then Exit Sub
If loZeile < 8 Or loZeile > 33 Then Exit Sub
chk = False
For Each Sh In ActiveWorkbook.Sheets
If Sh.Name = Right(Cells(loZeile, 13), 4) Then
chk = True
Exit For
End If
Next
If chk = False Then
MsgBox "kein passendes Arbeitsblatt gefunden"
Exit Sub
End If

'----Kopieren und löschen-----------------------
Application.EnableEvents = False

Sh.Unprotect
Me.Unprotect
Rows(loZeile).Copy
Sh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormulas
Rows(loZeile).EntireRow.Delete
Application.CutCopyMode = False
Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Application.EnableEvents = True
End Sub



Gruß ACR

Answer 8

Hallo ACR,

habe den Code mal so geändertt, dass er auf Spalte F und G gleichermaßen reagiert,

Private Sub Worksheet_Change(ByVal Target As Range)
Dim loZeile As Long
Dim Sh As Worksheet
Dim chk As Boolean
loZeile = Target.Row
'--- Prüfungen------
If Not Intersect(Target, Range("F8:G58")) Is Nothing Then
chk = False
For Each Sh In ActiveWorkbook.Sheets
If Sh.Name = Right(Cells(loZeile, 12), 4) Then
chk = True
Exit For
End If
Next
If chk = False Then
MsgBox "kein passendes Arbeitsblatt gefunden"
Exit Sub
End If
'----Kopieren und löschen-----------------------
Application.ScreenUpdating = False
Application.EnableEvents = False
Sh.Unprotect
Me.Unprotect
Rows(loZeile).Copy
Sh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormulas
Rows(loZeile).EntireRow.Delete
Application.CutCopyMode = False
Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub

Gruß
Rainer

Answer 9

Hallo Rainer

Superschnelle Antwort.
Leider hast Du meine Anfrage fasch interpretiert. Die Verschiebung der Zeile soll erst dann erfolgen, wenn alle 4 genannten Zellen Daten enthalten. Bei deiner Lösung wird verschoben, wenn in einer Zelle Daten eingefügt werden. Kannst Du das noch mal überprüfen????

Gruß ACR

Answer 10

Hallo ACR,

Deine letzte Antwort verwirrt mich etwas, indem Du jetzt von "4 genannten Zellen" sprichst.

Ich mache Dir deshalb den Vorschlag die Verschiebung mit einem Doppelklick auf die relevante Zeile der Spalte A au zu lösen.

Hier der geänderte Code dazu

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim loZeile As Long
Dim Sh As Worksheet
Dim chk As Boolean

loZeile = Target.Row

'--- Prüfungen------
If Not Intersect(Target, Range("A8:A58")) Is Nothing Then
chk = False
For Each Sh In ActiveWorkbook.Sheets
If Sh.Name = Right(Cells(loZeile, 12), 4) Then
chk = True
Exit For
End If
Next
If chk = False Then
MsgBox "kein passendes Arbeitsblatt gefunden"
Exit Sub
End If

'----Kopieren und löschen-----------------------
Application.ScreenUpdating = False
Application.EnableEvents = False

Sh.Unprotect
Me.Unprotect
Rows(loZeile).Copy
Sh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormulas
Rows(loZeile).EntireRow.Delete
Application.CutCopyMode = False
Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sh.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub

Gruß
Rainer