Rechnungsverwaltung

Hallo!
Ich möchte für meine kleine Firma ein Excel-Sheet machen, um meine Rechnungen zu verwalten.
Ich habe bereits erreicht, dass die Zeilen rot werden, wenn der erwartete Zahlungseingang verstrichen ist.
Nun hätte ich aber ganz gern, dass
a) die Rechnungen immer automatisch nach erwartetem Zahlungseingang sortiert werden, so dass oben die älteste Rechnung steht
b) wenn ich ein Datum in die Spalte "bezahlt am" eintrage, diese Zeile gelöscht und in ein anderes Datenblatt zum Archivieren verschoben wird. Wie dort die Sortierung ist, ist egal, am besten wäre es aber nach Rechnungsnummer, da die bei mir fortlaufend sind.
Ich hoffe, es kann mir jemand helfen, ansonsten muss ich es halt immer manuell machen ;-)
Viele Grüße,
Matthias

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) Dim Letzte As Long With Worksheets("Tabelle6") 'Tabellenname anpassen Letzte = .Cells(Rows.Count, 1).End(xlUp).Row Range("A2:D" & Letzte).Select 'D = rechte Spalte, anpassen End With 'D2 = sortierte Spalte, anpassen Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom End Sub

Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim lRow As Long With Worksheets("Tabelle2") 'Tabellenname anpassen lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(lRow, 1).Value = Cells(Target.Row, 1) 'für jede Spalte eine Zeile .Cells(lRow, 2).Value = Cells(Target.Row, 2) 'anpassen .Cells(lRow, 3).Value = Cells(Target.Row, 3) .Cells(lRow, 4).Value = Cells(Target.Row, 4) .Cells(lRow, 5).Value = Cells(Target.Row, 5) .Cells(lRow, 6).Value = Cells(Target.Row, 6) .Cells(lRow, 7).Value = Cells(Target.Row, 7) .Cells(lRow, 8).Value = Cells(Target.Row, 8) End With Selection.EntireRow.Delete End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If Target.Column = 7 Then Cells(Target.Row, 7) = Date 'in Spalte G wird datum eingefügt If Target.Column = 1 And Target.Row = 1 Then 'wird nur ausgeführte, wenn du auf A1 klicks Dim Letzte As Long With Worksheets("Rechnungen offen") 'Tabellenname anpassen Letzte = .Cells(Rows.Count, 1).End(xlUp).Row Range("B6:G" & Letzte).Select 'G = rechte Spalte End With 'F6 = sortierte Spalte, anpassen Selection.Sort Key1:=Range("F6"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom End If End Sub

Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Column = 7 Then Dim lRow As Long With Worksheets("Rechnungen bezahlt") 'Tabellenname anpassen lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(lRow, 1).Value = Cells(Target.Row, 2) .Cells(lRow, 2).Value = Cells(Target.Row, 3) .Cells(lRow, 3).Value = Cells(Target.Row, 4) .Cells(lRow, 4).Value = Cells(Target.Row, 5) .Cells(lRow, 5).Value = Cells(Target.Row, 6) .Cells(lRow, 6).Value = Cells(Target.Row, 7) End With ActiveCell.Offset(0, -5).Delete Shift:=xlUp End If End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If Target.Column = 7 And Target.Row > 5 Then Cells(Target.Row, 7) = Date 'in Spalte G wird Datum eingefügt Exit Sub End If If Target.Column = 1 And Target.Row = 1 Then 'wird nur ausgeführte, wenn du auf A1 klicks Dim Letzte As Long With Worksheets("Rechnungen offen") 'Tabellenname anpassen Letzte = .Cells(Rows.Count, 1).End(xlUp).Row Range("B6:G" & Letzte).Select 'G = rechte Spalte End With 'D6 = sortierte Spalte, anpassen Selection.Sort Key1:=Range("D6"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom [B6].Select End If End Sub

Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Column = 7 And Target.Row > 5 Then Dim lRow As Long With Worksheets("Rechnungen bezahlt") 'Tabellenname anpassen lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 .Cells(lRow, 1).Value = Cells(Target.Row, 2) .Cells(lRow, 2).Value = Cells(Target.Row, 3) .Cells(lRow, 3).Value = Cells(Target.Row, 4) .Cells(lRow, 4).Value = Cells(Target.Row, 5) .Cells(lRow, 5).Value = Cells(Target.Row, 6) .Cells(lRow, 6).Value = Cells(Target.Row, 7) End With Cells(Target.Row, 2).Delete Shift:=xlUp Cells(Target.Row, 3).Delete Shift:=xlUp Cells(Target.Row, 4).Delete Shift:=xlUp Cells(Target.Row, 5).Delete Shift:=xlUp Cells(Target.Row, 6).Delete Shift:=xlUp Cells(Target.Row, 7).Delete Shift:=xlUp End If End Sub

Hallo Matthias,
habe noch einiges geändert, jetzt sollte es fehlerfrei funktionieren.
Gruss Beni


Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Target.Column = 7 And Target.Row > 5 And Cells(Target.Row, 2) <> "" Then
InMldg = MsgBox("Willst Du das aktuelle Datum eintragen?", vbYesNo + vbQuestion, "Rechnung bezahlt ?", "", 0)
If InMldg = 6 Then
Cells(Target.Row, 7) = Date 'in Spalte G wird Datum eingefügt
End If
Exit Sub
End If
If Target.Column = 1 And Target.Row = 1 Then 'wird nur ausgeführte, wenn du auf A1 klicks
Dim Letzte As Long
With Worksheets("Rechnungen offen") 'Tabellenname anpassen
Letzte = .Cells(Rows.Count, 1).End(xlUp).Row
Range("B6:G" & Letzte).Select 'G = rechte Spalte
End With
'D6 = sortierte Spalte, anpassen
Selection.Sort Key1:=Range("D6"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
[B6].Select
End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Column = 7 And Target.Row > 5 Then
If Target = "" Then Exit Sub
Dim lRow As Long
With Worksheets("Rechnungen bezahlt") 'Tabellenname anpassen
lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lRow, 1).Value = Cells(Target.Row, 2)
.Cells(lRow, 2).Value = Cells(Target.Row, 3)
.Cells(lRow, 3).Value = Cells(Target.Row, 4)
.Cells(lRow, 4).Value = Cells(Target.Row, 5)
.Cells(lRow, 5).Value = Cells(Target.Row, 6)
.Cells(lRow, 6).Value = Cells(Target.Row, 7)
End With
Cells(Target.Row, 2).Delete Shift:=xlUp
Cells(Target.Row, 3).Delete Shift:=xlUp
Cells(Target.Row, 4).Delete Shift:=xlUp
Cells(Target.Row, 5).Delete Shift:=xlUp
Cells(Target.Row, 6).Delete Shift:=xlUp
Cells(Target.Row, 7).Delete Shift:=xlUp
End If
End Sub

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread