Supportnet / Forum / Tabellenkalkulation

Hallo, wer kann mir helfen eine Formel zu finden um ein Kassenbuch sortiert in andere Tabellen zu kopieren. Das Kassenbuch ist so aufgebaut das in Spalte A das Datum steht, in Spalte B der Text und in C und D Ein- und Ausgaben. Nun möchte ich die Zeilen mit dem Text "Bank" in die Tabelle Bank kopieren, die Zeilen mit dem Text "Müll" in die Tabelle Müll kopieren usw. Wer kennt eine Formel für mein Problem. Danke

Hallo Tiffi,

nachfolgendes Makro sollte das machen, was Du Dir vorgestellt hast. In dem Makro wird der Name aus Spalte B mit den in der Datei vorkommenden Blattnamen verglichen und wenn das Blatt vorhanden ist, wird die Zeile aus dem Tabellenblatt mit dem Namen "Kassenbuch" in das entsprechende Bankblatt kopiert und in der nächsten freien Zeile eingefügt.

Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.

Option Explicit

Sub Sortieren()
Dim iRow As Long
Dim iSheet As Integer
For iRow = 2 To Sheets("Kassenbuch").Range("B65536").End(xlUp).Row
    For iSheet = 1 To Worksheets.Count
        If Sheets(iSheet).Name = Sheets("Kassenbuch").Cells(iRow, 2) Then
            Sheets("Kassenbuch").Rows(iRow).Copy _
                Sheets(iSheet).Cells(Sheets(iSheet).Range("B65536").End(xlUp).Offset(1, 0).Row, 1)
        End If
    Next
Next
End Sub

Sollte Dein Tabellenblatt, in dem sich die ganzen Ein- und Ausgaben befinden, einen anderen Namen haben, so müssen in dem Makro alle Blattnamen abgeändert werden. Hierzu einfach die Texte "Kassenbuch" durch Deinen Blattnamen ersetzen.
Was noch interessant zu wissen wäre, ob in dem Blatt, in dem die Werte aufgelistet und von dem kopiert werden soll, immer nur neue Daten aufgeführt werden oder auch die alten Werte dort erhalten bleiben. Sind dort immer alle, also auch die alten bereits kopierten Werte aufgelistet, so müsste am Anfang des Makros die Werte in den einzelnen Tabellenblättern zuerst gelöscht werden, da ansonsten die bereits übertragenen Werte erneut übertragen würden, was ja falsch wäre. Dazu müssten die Zeilen

For iSheet = 1 To Worksheets.Count
    If LCase(Sheets(iSheet).Name) <> LCase("Kassenbuch") Then
        Sheets(iSheet).Cells.ClearContents
    End If
Next

am Anfang des Makros eingefügt werden. Die Zeilen bewirken, dass in allen Bankblättern die Daten gelöscht werden. Sollten sich noch weitere Blätter, außer den Bankblättern und dem Kassenbuchblatt befinden, müsste beim Löschen diese Blätter ausgeklammert werden, da ansonsten dort ebenfalls die Daten gelöscht würden. Das macht man genau wie in den obigen Zeilen mit dem Kassenblatt gemacht wurde, also

If LCase(Sheets(iSheet).Name) <> LCase("Kassenbuch") Then

nur eben mit einem anderen Namen als “Kassenbuch.
Sollten in der Auflistung immer nur neue Daten stehen, entfällt diese Prozedur.

Solltest Du nicht wissen, wie Du den Code in Deine Datei bekommst, dann schau mal auf meiner HP in der Rubrik Anleitungen und dort dann in der Anleitungsnummer 3 nach. Dort stelle ich dazu eine bebilderte Anleitung zur Verfügung, die Dir sicherlich helfen wird.

Bei Fragen melde Dich.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du}
^{ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hallo,

ich nochmal. Bitte verwende das nachfolge Makro mit einer kleinen Schönheitskorrekur.

Option Explicit

Sub Sortieren()
Dim iRow As Long
Dim iSheet As Integer
For iRow = 2 To Sheets("Kassenbuch").Range("B65536").End(xlUp).Row
    For iSheet = 1 To Worksheets.Count
        If LCase(Sheets(iSheet).Name) = LCase(Sheets("Kassenbuch").Cells(iRow, 2)) Then
            Sheets("Kassenbuch").Rows(iRow).Copy _
                Sheets(iSheet).Cells(Sheets(iSheet).Range("B65536").End(xlUp).Offset(1, 0).Row, 1)
        End If
    Next
Next
End Sub

Alles andere Bleibt wie in AW1 beschrieben.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du}
^{ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hallo Oliver,
danke für deine schnelle Nachricht. Leider komme ich heute nicht mehr dazu es zu installieren.
Die Daten in dem Tabellenblatt "Kassenbuch" werden vom 1.1. - 31.12. fortlaufend eingetragen und bleiben bestehen. Das kopieren der einzelnen Daten in verschiedene Tabellenblätter hat den Vorteil, das alles besser überschaubar ist, wie die Ein- und Ausgaben sich verhalten.
Ich melde mich, und nochmal Danke.

MfG Tiffi

Hallo Oliver,
habe dein Macro installiert, klappt wunderbar. Nur eine Kleinigkeit hätte ich da noch.
Auf den Tabellenblättern habe ich den Kopf des Blattes in den ersten 5 Zeilen und der Text wird leider auch mit gelöscht. Das heißt: Löschen bzw. einfügen erst ab Zeile 6.
Läst sich das noch ändern?

MfG Tiffi

Hallo Tiffi,

dann sieht das Makro wie folgt aus:

Option Explicit

Sub Sortieren()
Dim iRow As Long
Dim iSheet As Integer
Dim iFirstRow As Long
'Daten löschen
For iSheet = 1 To Worksheets.Count
    If LCase(Sheets(iSheet).Name) <> LCase("Kassenbuch") Then
        Sheets(iSheet).Range("A6:IV65536").ClearContents
    End If
Next
'Daten einfügen
For iRow = 2 To Sheets("Kassenbuch").Range("B65536").End(xlUp).Row
    For iSheet = 1 To Worksheets.Count
        If Sheets(iSheet).Name = Sheets("Kassenbuch").Cells(iRow, 2) Then
            iFirstRow = Sheets(iSheet).Range("B65536").End(xlUp).Offset(1, 0).Row
            If iFirstRow < 6 Then iFirstRow = 6
            Sheets("Kassenbuch").Rows(iRow).Copy _
                Sheets(iSheet).Cells(iFirstRow, 1)
        End If
    Next
Next
End Sub

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du}
^{ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hallo Oliver,
auch dein letztes Macro läuft super . Ich möchte mich noch ein mal recht herzlich bei dir für deine Mühe bedanken.

Danke Tiffi

• Suche Excelformel
• Excelformel für Vergleich bzw. Abfrage
• Excelformel gesucht
• Excelformel
• Excelformel