VBA: Bereich kopier. ohne Zeil. mit "Bb"

Hallo liebe VBA-Profis,
meine Tabelle besitzt ein Sheet, in dem archivierte Daten ab Zeile 142 hinterlegt sind über eine Breite von 71 Spalten. Von diesen Daten möchte ich die 10 neuesten Datensätze (= 10 unterste Zeilen) nach oben (B64:BM74) kopieren und dabei Zeilen mit Eintrag "Bb" ausschließen (siehe Sheet "Tabelle1").
Excel-Datei: https://www.herber.de/bbs/user/145170.xlsm
Auf Excel-Filter bzw. VBA-Code wie
.Range("$B$63:$K$101").AutoFilter Field:=5, Criteria1:="*Bb*", Operator:=xlAnd
möchte ich verzichten.
Bisher ist es mir nur möglich, den gesamten Datenbereich nach oben zu kopieren (siehe Sheet "Tabelle2"):

Sub CopyWithoutBb()
Dim tarWks As Worksheet
Set tarWks = Worksheets("Tabelle2")
With tarWks
cntall = .Cells(137, 5)
.Range("B64:BM74") = .Range("B" & cntall - 10 & _
":BM" & cntall).Value
End With
End Sub

Welche Abfrage muss man dafür einfügen?
Vielen Dank im Voraus und viele Grüße
Max

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub CopyWithoutBb() Dim tarWks As Worksheet Dim arr Dim loletzte As Long, i As Long, cnt As Long, insertrow As Long insertrow = 64 Set tarWks = Worksheets("Tabelle2") With tarWks .Cells(64, 2).Resize(10, 71).ClearContents loletzte = .Cells(Rows.Count, "B").End(xlUp).Row arr = .Cells(142, 2).Resize(loletzte - 142 + 1, 71) For i = UBound(arr) To LBound(arr) Step -1 If insertrow = 75 Then Exit Sub For cnt = 1 To UBound(arr, 2) If LCase(arr(i, cnt)) = "bb" Then Exit For End If Next If cnt > UBound(arr, 2) Then .Cells(insertrow, "B").Resize(, 71).Value = .Cells(i + 142 - 1, "B").Resize(, 71) _ .Value insertrow = insertrow + 1 End If Next ' cntall = .Cells(137, 5) ' .Range("B64:BM74") = .Range("B" & cntall - 10 & _ ' ":BM" & cntall).Value End With End Sub

If insertrow = 75 Then Exit Sub ' nach 64 +10 Zeilen steigt der Code aus. nach der 10. Zeile wird insertrow nochmal hochgesetzt also 75
Zur Erklärung.
letzte Zeile in Spalte B ermitteln
Der Datenbereich wird in ein array eingelesen. wegen Geschwindigkeit.
Äußere Schleife über die Zeilen des Arrays von unten nach oben.
Dann innere Schleife über die Einträge der Zeile
Vergleich Zellinhalt auf "bb" und zwar indem beide Werte in Kleinbuchstaben umgewandelt werden (lcase(wert)) und Abbruch wenn gefunden.
Abfrage ob die Zählvariable cnt bis zum Schluß ( ohne Fund) durch die Elemente der Zeile gelaufen ist. Dann ist der Zähler höher als die Anzahl der Einträge ( UBound(arr,2 )) In diesem Falle wird die Zeile oben eingetragen und der Zeilenzähler um 1 erhöht.
Für die richtige Reihenfolge der Einträge könnte man insertrow entsprechend hochsetzen (startwert) und dann um 1 reduzieren statt erhöhen.
gruß
rb

Beliebteste Forumthreads (12 Monate)

VBA: Bereich kopier. ohne Zeil. mit "Bb"

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA: Bereich kopier. ohne Zeil. mit "Bb"

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread