Excel VBA: Schleifen_CurrentRange kopieren und in neues Tabellenblatt einfügen

[MirkoP]

Guten Tag,
ich benötige wieder die Hilfe eines VBA-Experten, da ich mein aktuelles Problem von alleine nicht mehr lösen kann:

• Ich besitze ein Arbeitsblatt namens "Kontoauszüge", in der alle Mieter-Konten abgebildet sind.
  

• Ich möchte nun alle Konten dieses Arbeitsblattes, in der offene Posten aufscheinen, kopieren und in ein neues, bereits angelegtes Tabellenblatt "Offene_Posten" kopieren.
  
• Alle Konten in "Kontoauszüge" sind am oberen und am unteren Ende durch eine Leerzeile getrennt.
  
• Aus meiner Sicht soll die Suche über eine For-next-Schleife erfolgen und zwar:
  Wenn in der Zelle der Spalte "A" "Neuer Saldo" steht und in der selben Zeile die Zelle in Spalte "E" > 0 ergibt, dann soll es das gesamte Konto kopieren (-> über CurrentRegion) und in das Tabellenblatt "Offene_Posten" kopieren (ab Zeile 5). 
  

Mein Problem bei meinem VBA-Code, den ich im Anschluss anhänge ist folgender:
Es fügt mir immer ab zeile 5 im Tabellenblatt "Offene_Posten" die Koten ein. Ich brauche eine Ergänzung, dass während des Schleifenablaufs das jeweilige Konto immer in der letzten leeren Zeile einfügt. Es soll auch zwischen den Konten eine leere Zeile stehen bleiben. Ich habe im Internet leider noch keine vergleichbare Lösung gefunden, zumal die einzelnen Konten allesamt unterschielich groß sind (Anzahl der Zeilen ist unterschiedlich).

Ich wäre froh und dankbar, wenn mir jemand helfen könnte. Vielen Dank.
Ich lege auch eine Beispieldatei bereit, in der ich ein paar Konten illustrativ verpackt habe.

Schöne Grüße, Mirko

... und hier mein Code:

Code:

Sub OPOS_Kopieren()
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Dim lngZ As Long
Dim lngZZ As Long

Set wksQ = Worksheets("Kontoauszüge") 'Quellblatt
Set wksZ = Worksheets("Offene_Posten") 'Zielblatt
lngZZ = 5

With wksQ
For lngZ = 5 To .Cells(Rows.count, 1).End(xlUp).Row


   
    If wksQ.Cells(lngZ, 1).Value = "Neuer Saldo" And wksQ.Cells(lngZ, 5).Value > 0 Then
        Cells(lngZ, 1).Select

        ActiveCell.CurrentRegion.Select
        Selection.Copy Destination:=Worksheets("Offene_Posten").Cells(lngZZ, 1)
  
    End If
Next
End With

End Sub

[schauan]

Hallöchen,

ich würde die erste leere Zeile nehmen. Ist in der Regel deutlich weiter oben als die letzte

Finden kannst Du die mit

Cells(Rows.Count, 1).End(xlUp).Row + 1

wobei Du statt , 1) die Spalte nimmst, die auch immer entsprechend der Datenlage gefüllt ist.

[MirkoP]

Hallo André,
vielen Dank für Deine rasche Rückantwort.
Ich habe es mal ausprobiert, aber ich habe es wohl nicht ganz verstanden.
Soll ich für das Worksheet "wksZ" eine neue Schleife einbauen?
Das habe ich gemacht, aber das funktioniert leider so nicht.

Code:

With wksZ
For lngZZ = 5 To .Cells(Rows.count, 1).End(xlUp).Row + 1

[MirkoP]

Guten Tag an alle,
vollständigkeitshalber schicke ich den VBA-Code zu, der nun für mich so funktioniert. Vielleicht hilft es ja jemandem weiter; würde mich freuen!
Lieben Gruß, Mirko

Code:

Sub OPOS_Kopieren()
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Dim lngZ As Long
Dim lngZZ As Long

Set wksQ = Worksheets("Kontoauszüge") 'Quellblatt
Set wksZ = Worksheets("Offene_Posten") 'Zielblatt
lngZZ = 5

Worksheets("Offene_Posten").Activate
ActiveSheet.Range("A4:F10000").Select
Selection.ClearContents

Worksheets("Kontoauszüge").Activate
Columns("G:M").Select
Selection.ClearContents

With wksQ
For lngZ = 5 To .Cells(Rows.count, 1).End(xlUp).Row


   
    If wksQ.Cells(lngZ, 1).Value = "Neuer Saldo" And wksQ.Cells(lngZ, 5).Value > 0 Then
        Cells(lngZ, 1).Select

        ActiveCell.CurrentRegion.Select
        ActiveCell.CurrentRegion.Copy
        Selection.Copy
        wksZ.Cells(lngZZ, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
             
        lngZZ = Worksheets("Offene_Posten").Cells(Rows.count, 1).End(xlUp).Row + 2
 
    End If
Next
End With

End Sub