AW: Bereich Kopieren in Abhängigkeit v Wert
20.03.2023 10:32:17
Mathias
Dann könnte ich dir gleich noch einen kleinen Denkfehler in der Zeile
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
aufzeigen. Dort hast du als Spalte 1 angegeben. Da die Spalte 1 leer ist (Bis auf die Überschrift) kommt da dann "1" raus.
Dadurch durchläuft deine Schleife nicht alle Angaben aus Spalte 5.
Ich hab mal einen Code zusammengeschrieben, der alle Einnahmen (also alles größer 0) in zu den Einnahmen verschiebt.
Option Explicit
Sub myCopy()
Application.ScreenUpdating = False 'ScreenUpdate wird wärend des Makros deaktiviert, da der Code dann schneller läuft.
Dim mySheet As Worksheet
Set mySheet = ThisWorkbook.Worksheets("Bankaufstellung") 'Speichert das entsprechende Tabellenblatt in eine Variable.
Dim lngEinnahmen, lngAusgaben As Long
lngEinnahmen = mySheet.Cells(mySheet.Rows.Count, 1).End(xlUp).Row + 1 'Speichert die erste freie Zeile bei den Einnahmen in eine Variable.
lngAusgaben = mySheet.Cells(mySheet.Rows.Count, 5).End(xlUp).Row 'Speichert das Ende der Ausgaben in eine Variable.
Dim i As Long
For i = 2 To lngAusgaben 'Durchläuft die Ausgaben bis das Ende erreicht ist.
If mySheet.Cells(i, 5).Value2 > 0 Then 'Wenn der Wert größer 0 ist (also positiv) werden die Zeilen bis zum "End If" ausgeführt.
Dim rngStart, rngZiel As Range
Set rngStart = Range(mySheet.Cells(i, 5), mySheet.Cells(i, 8)) 'Setzt den Bereich der zu verschiebenden Daten.
Set rngZiel = Range(mySheet.Cells(lngEinnahmen, 1), mySheet.Cells(lngEinnahmen, 4)) 'Setzt den Bereich wo die Daten hingeschoben werden sollen.
rngStart.Cut rngZiel 'Schiebt die Daten von dem angegebenen Startbereich in den angegebenen Zielbereich.
lngEinnahmen = lngEinnahmen + 1 'Da nun die Liste der Einnahmen verlängert wurde, ist die nächste freie Zeile eine Zeile tiefer.
End If
Next
Application.ScreenUpdating = True 'Am Ende des Makros wird ScreenUpdate wieder aktiviert.
End Sub
Falls du Probleme haben sollten den Rest deines Codes darum zu schreiben, dann helfen wir dir natürlich gerne weiter.
Liebe Grüße
Mathias