Zeile ausschneiden und in neues Arbeitsblatt einfügen, wenn Bedingung erfüllt

Question

Hallo Forum,

ich habe für Excel eine Tabelle, welche ich automatisiert pflegen möchte.
In dem Blatt "offene Zahlungen" stehen in jeder Reihe Daten (Datum, Empfänger usw.) und eben in Spalte E "Zahlung erledigt".
Wenn ich nun in in den Zellen der Spalte E ein "x" eintrage, möchte ich, daß die dazugehörige Zeile in eine neues Blatt names "bestätigte Zahlungen" jeweils in die nächste freie Zeile kopiert wird.
Ist das mit VBA möglich? Leider habe ich von VBA null Ahnung

Viele Grüße

Micha

Answer 1

Hallo Michael,

das geht fast so wie du willst. Kopiere das folgende Makro in das VBA-Projekt des Arbeitsblatts "offene Zahlungen":

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngEinf As Long

If Not Intersect(Target, Range("E:E")) Is Nothing Then
   'prüfen, ob in Spalte E ein x eingegeben wurde
   If Target.Value = "x" Then
     'nächste leere Zeile in Spalte A im Arbeitsblatt bestätigte Zahlungen suchen und um 1 erhöhen
     With ThisWorkbook.Worksheets("bestätigte Zahlungen")
       lngEinf = .Cells(Rows.Count, 1).End(xlUp).Row + 1
     End With
     'Zeile kopieren
      ActiveSheet.Rows(Target.Row).Copy Destination:=ThisWorkbook.Worksheets("bestätigte Zahlungen").Rows(lngEinf)
   End If
End If
End Sub

Gibst du ein x in Spalte E ein musst du die Zelle verlassen, dann wird die Zeile, in der du das x gesetzt hast, kopiert.

Gruß

M.O.

Answer 2

Moin Michael,

es bleibt mir nur, Dich zu ermutigen, es mal mit VBA zu versuchen.

Deine Aufgabe lässt sich mit VBA auf (mindestens) drei verschiedenen Wegen lösen.

1. wenn Du Deine Zahlungseingänge in einem Sheet(Arbeitsblatt) in einem Rutsch übertragen willst, setzt du z.B. mit einem Doppelklick einfach ein x in Spalte E. Anschließend erledigt eine Schleife Deine Übertragungswünsche. 
2. willst Du das aber sofort für eine Zeile tun, könnte ein Doppelklick bewirken, dass - und jetzt kommt's- 
   1. diese Zeile (übrigens egal in welche Zelle geklickt) in die "bestätigten"  übertragen wird oder auch 
   2. gleich in der ersten Tabelle eliminiert => aufgeräumt wird. Es bleiben nur die säumigen übrig.

Je nach Arbeitsweise bieten sich alle drei Varianten an. Oder vielleicht eine, die Zahlungseingänge gleich automatisch  den Rechnungen zuordnet ... und aufräumt ...?

Denn, wenn die Zahlungseingänge per .csv oder Tabelle einreisen, müsste man eigentlich nicht mehr machen, als das einmalig entsprechend anzupassen.

Liebe Grüße

d'r Bastler von den VBAsteleien.de

Answer 3

Hi Micha,

wenn du direkt beim Eintragen von "x" in Spalte E die Daten übertragen möchtest besteht die Gefahr, dass du versehentlich in der falschen Zeile das "x" setzt und dann werden die falschen Daten übertragen. Deshalb würde ich es lieber wie folgt machen:

1. trage zuerst in alle Zeilen in Spalte E ein "x" ein die übertragen werden sollen

2. wenn alle zu übertragenden Zeilen ein "x" haben mache in Spalte E einen Doppelklick

3. der Doppelklick löst dann den Code aus der alle mit "x" gekennzeichneten Zeilen überträgt

Dazu musst du folgenden Code ins Codemodul des Tabellenblatte "offene Zahlungen" kopieren:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim lngZeile As Long
    Dim lngErste As Long
    Dim rngUebertragen As Range
    If Not Intersect(Target, Columns(5)) Is Nothing Then
        ' in Spalte E steht mindesten 1 mal "x" oder "X"
        If Application.CountIf(Columns(5), "x") > 0 Or Application.CountIf(Columns(5), "X") > 0 Then
            ' Zellbearbeitung abschalten
            Cancel = True
            ' erste freie Zeile in Tabellenblatt "bestätigte Zahlungen" ermitteln
            lngErste = Worksheets("bestätigte Zahlungen").Cells(Rows.Count, 1).End(xlUp).Row + 1
            ' Schleife von Zeile 2 bis letzte belegte Zeile
            For lngZeile = 2 To Cells(Rows.Count, 1).End(xlUp).Row
                ' in laufender Zeile Spalte E steht "x" oder "X"
                If UCase(Cells(lngZeile, 5)) = "X" Then
                    ' Variable noch leer
                    If rngUebertragen Is Nothing Then
                        ' laufende Zelle Spalte A in Variable schreiben
                        Set rngUebertragen = Cells(lngZeile, 1)
                    ' Variable bereits belegt
                    Else
                        ' laufende Zelle Spalte A zusätzlich in Variable schreiben
                        Set rngUebertragen = Union(rngUebertragen, Cells(lngZeile, 1))
                    End If
                End If
            Next lngZeile
            ' es wurden Zellen mit "x" oder "X" in Spalte E gefunden und stehen in der Variablen
            If Not rngUebertragen Is Nothing Then
                ' alle Zeilen die in der Variablen stehen kopieren
                rngUebertragen.EntireRow.Copy Worksheets("bestätigte Zahlungen").Cells(lngErste, 1)
                ' alle Zeilen di in der Variablen stehen löschen
                rngUebertragen.EntireRow.Delete shift:=xlUp
            End If
        End If
    End If
End Sub

Ins Codemodul des Tabellenblattes gelangst du wie folgt: Alt+F11 öffnet den VBA-Editor. Im dortigen linken Fenster siehst du alle VBA-Bestandteile deiner Arbeitsmappe - da steht u.a. dann z.B. Tabelle1(offene Zahlungen). Darauf machst du einen Doppelklick, sodass im rechten Teil des VBA-Editors ein leeres Fenster angezeigt wird. Den gesamten Code kopierst du dann in dieses rechte Fenster. Aktiviere dann wieder dein Tabllenblatt "offene Zahlungen" und schon kann es losgehen: Doppelklick in Spalte E und alle mit "x" gekennzeichneten Zeilen werden übertragen.

Bis später, Karin