Nächste freie Zeile ab bestimmter Zelle suchen

Hallo zusammen,
ich möchte per Makro Werte aus einem Worksheet "Daten" Werte in eine Worksheet "Results" kopieren. Im angehängten Bild seht ihr das Worksheet "Results". Die Werte sollen in die nächste freie Zeile kopiert werden, in diesem Falle in Zeile 23. Die nächste freie Zeile soll aber unterhalb von "Max." in Spalte A gesucht werden, damit die Versuchspunkte nicht im Bereich "Clean Gas" erscheinen. Die Zelle A16 mit dem Wert "Max." kann allerdings verschoben werden, wenn im oberen Bereich Zeilen eingefügt oder gelöscht werden, d.h. das Makro muss den Wert "Max. suchen und ab da die nächste freie Zeile finden.
Wenn die nächste freie Zeile außerhalb des gelben Bereichs liegt (die Zeile mit dem Wert "END" in Spalte A), dann soll idealerweise automatisch eine neue Zeile oberhalb von "END" eingefügt und die Werte dort hineinkopiert werden.
Bisher ist mein Ansatz zum finden der nächsten freien Zeile wie folgt (damit wird jedoch ab Zeile 1 gesucht und nicht nur unterhalb von "Max.") :

Sub letzte_zelle2()
Sheets("Results").Select
Cells(1, 1).Activate
Set zelle = Cells.Find("Max.", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart)
If Not zelle Is Nothing Then
zeile = zelle.Row
spalte = zelle.Column
End If
With Columns(spalte)
Set zelle = .Find("")
Do
zeile = zelle.Row
If Cells(zeile + 1, spalte).Value = "" Then Exit Do
Set zelle = .FindNext(zelle)
Loop
End With
If zeile = 2 Then zeile = 3
n0 = zeile
Cells(zeile, spalte).Activate
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub aa() Dim lngMax As Long, lngEND As Long, lngRow As Long With Sheets("REsults") lngMax = Application.Match("Max.", .Columns(1), 0) lngEND = Application.Match("END", .Columns(1), 0) If WorksheetFunction.Count(.Range(.Cells(lngMax + 1, 1), .Cells(lngEND - 1, 1))) _ = lngEND - lngMax - 1 Then .Rows(lngEND).Insert lngRow = lngEND Else lngRow = .Cells(lngEND, 1).End(xlUp).Row + 1 End If Application.Goto .Cells(lngRow, 1) 'nur zum testen End With End Sub

HI
es gibt einen wichtigen Unterschied zwischen deiner Testdatei, die du hier hochgeladen hast und der Datei bzw dem Bild auch deiner eingangsbeschreibung:
in deiner Eingangsbeschreibung war die auch die Spalte A (Testrun) nur soweit ausgefüllt, wie die daneben liegenden Spalten.
in der Datei, die du jetzt hochgeladen hast, ist jedoch die Spalte A schon bis END ausgefüllt auch wenn die daneben liegen Zellen leer sind.
das wirft natürlich einige Fragen bezüglich des Einfügeortes der Zeile aus Daten auf.
möglich wären aus meiner sicht folgende Varianten:
a) in einer neuen Zeile 34, das End wird dabei um 1 weiter nach unten verschoben, weil Spalte A schon vollständig befüllt ist
b) in Zeile 23, weil das von den Gesamtdaten her die erste freie Spalte ist, dabei wird dann die Testrun-Nummer 7 mit 8 überschrieben.
c) in Zeile 24, weil dort die gleiche Testrunnummer (8) steht wie in Daten.
zunächsteinmal solltest du dich festlegen, welche Dateiart bei dir tatsächlich vorliegt, dh so wie in deinem Bild in der ersten Anfrage oder so wie in deiner Beispieldatei und wenn zweiteres, dann solltest du genau beschreiben wo die Daten eingefügt werden sollen.
Gruss Daniel

Sub aa() Dim lngMax As Long, lngEND As Long, lngRow As Long With Sheets("REsults") lngMax = Application.Match("Max.", .Columns(1), 0) lngEND = Application.Match("END", .Columns(1), 0) If WorksheetFunction.CountA(.Range(.Cells(lngMax + 1, 2), .Cells(lngEND - 1, 2))) _ = lngEND - lngMax - 1 Then .Rows(lngEND).Insert lngRow = lngEND Else lngRow = .Cells(lngEND, 2).End(xlUp).Row + 1 End If Application.Goto .Cells(lngRow, 2) 'nur zum testen End With End Sub

Sub aa() Dim lngMax As Long, lngEND As Long, lngRow As Long With Sheets("REsults") lngMax = Application.Match("Max.", .Columns(1), 0) lngEND = Application.Match("END", .Columns(1), 0) If WorksheetFunction.CountA(.Range(.Cells(lngMax + 1, 1), .Cells(lngEND - 1, 1))) _ = lngEND - lngMax - 1 Then .Rows(lngEND).Insert .Cells(lngEND - 1, 1).Resize(, 7).Copy .Cells(lngEND, 1).PasteSpecial xlPasteFormats Application.CutCopyMode = False lngRow = lngEND Else lngRow = .Cells(lngEND, 1).End(xlUp).Row + 1 End If Application.Goto .Cells(lngRow, 1) 'nur zum testen End With End Sub

Beliebteste Forumthreads (12 Monate)

Nächste freie Zeile ab bestimmter Zelle suchen

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Nächste freie Zeile ab bestimmter Zelle suchen

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread