Clever-Excel-Forum

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

Hallöchen,

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

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.

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

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

MirkoP

schauan

MirkoP

MirkoP