Zeile kopieren wenn Bedingung erfüllt ist

Question

Hallo Exelgemeinde

Habe mal wieder ein Problem mit meiner Exeldatei. Ich möchte vom Blatt "Arztrechnungen" mittels VBA die entsprechende Zeile in ein anderes Blatt ("Abgabe") kopieren, wenn in Zelle M8 ein Datum eingegeben wird. Die Zeile soll in die nächste freie Zeile des Blattes "Abgabe" eingefügt werden. Ich arbeite mit Exel2003

Answer 1

Hallo Unbekannte(r),

Dir ist schon klar das es dann durcheinander ist. Vielleicht beim ersten mal in A3 das nächste mal in IV4 usw.
In Welcher Tabelle ist die Zelle M8?

Gruß Hajo

Answer 2

Hallo Hajo

Die Zelle M8 befindet sich auf dem Blatt Arztrechnungen. Bezüglich Deiner Antwort ist mir nicht klar wieso dann etwas durcheinander kommt. Alle kopierten Zeilen werden nacheinander auf Blatt Abgabe kopiert. Trotzdem: Vielleicht kannst Du mir bei meinen Problem ja helfen.
Danke schonaml

Horst

Answer 3

Hallo Horst,

ich hatte mich verlesen, ich dachte Zelle.
Unter die Tabelle Arztrechnung

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$M$8" And IsNumeric(Target) Then
Rows(8).Copy Worksheets("Abrechnung").Rows(Worksheets("Abrechnung").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
End If
End Sub

Gruß Hajo

Answer 4

Hallo Exelfreaks und Hallo Hajo

In meiner Anfrage habe ich mich wohl ein wenig unklar ausgedrückt. Ich habe im Tabellenblatt "Arztrechnungen" mehrere Einträge (ca. A8 bis N25) einige der Zellen sind noch leer und werden erst später ausgefüllt. Entscheidend ist hierbei die DATUMS-Eingabe in den Zellen M8 bis M25. Die entsprechende ZEILE soll bei Eingabe des Datums ins Tabellenblatt "Abrechnung" (M8bisM25) kopiert werden.

Hajo, Dein Code funktioniert so nicht. Vielleicht könntes Du mir ja nochmals behilflich sein??

Gruß Horst

Answer 5

Hallo Horst,

meine Code geht für Deine Beschreibung aus dem ersten. Bei Eingabe in M8 wird die Zeile kopiert.
Ich mache den Code immer für die Beschreibung die im Beitrag steht.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
If Target.Column = 13 And Target.Row >= 8 And Target.Row <= 25 And IsNumeric(Target) Then
Rows(Target.Row).Copy Worksheets("Abrechnung").Rows(Worksheets("Abrechnung").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
End If
End If
End Sub

Gruß Hajo

Answer 6

Hallo Hajo

Fuktioniert einwandfrei. Danke

Gruß Horst