Hallo Zusammen, ich habe auf einer Tabellenseite einen Button der mir einen Userform öffnet (klappt einwandfrei), in dieser kann ich dann eine Benennung eintragen, und eine Auswahltreffen für welchen Komponente ich den neuen Eintrag haben möchte. (klappt einwandfrei). Beim betätigen des Generieren Button wird eine Abfrage gestartet welche Auswahl getroffen wurde und davon abhängig wird ein bestimmter vorgefertigter Zeilenbereich kopiert. (klappt einwandfrei) anschließend SOLL die erste freie Zeile gefunden werden also die erste Freie Zeile nach dem letzten Eintrag (klappt nicht) und dort soll alles eingefügt werden. (klappt teilweise).

Statt mir die erste Freie Zeile zu finden wird immer die Letzte beschriebene Zeile anvisiert, und beim einfügen wird die vorbereitete Gruppierung nicht mitgenommen.
Ich habe versucht mir mit ChatGPT weiterzuhelfen, komme aber mit unterschiedlichen Definitionen immer wieder auf das gleiche Problem. Ich hoffe jemand smartes kann mir hier weiterhelfen, weil ich verblöde langsam an dem Problem.^^ VG

Private Sub CommandButton_Generieren_Click()
Dim ws As Worksheet
Dim text As String
Dim firstEmptyRow As Long
Dim sourceRange As Range
Dim targetRange As Range

' Setze das Arbeitsblatt
Set ws = ThisWorkbook.Sheets("Bohren STK")

' Hole den Text aus der TextBox
text = String(10, " ") & TextBox_Benennung.text ' 10 Leerzeichen vor dem Text

' Wähle den Zeilenbereich basierend auf dem ausgewählten Kontrollkästchen
If CheckBox_Wipperkran.Value Then
Set sourceRange = ws.Rows("2:67")
ElseIf CheckBox_Turmelement.Value Then
Set sourceRange = ws.Rows("68:81")
ElseIf CheckBox_Laufkatzkran.Value Then
Set sourceRange = ws.Rows("2:67")
ElseIf CheckBox_Kreuzrahmen.Value Then
Set sourceRange = ws.Rows("68:81")
Else
MsgBox "Bitte wählen Sie eine Option aus."
Exit Sub
End If

' Zeilenbereich einblenden
sourceRange.Hidden = False

' Text in die erste Zelle des Quellbereichs übertragen
sourceRange.Cells(1, 1).Value = text

' Bereich kopieren
sourceRange.Copy

' Erste freie Zeile finden
firstEmptyRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1

' Zielbereich festlegen
Set targetRange = ws.Rows(firstEmptyRow & ":" & firstEmptyRow + sourceRange.Rows.Count - 1)

' Bereich einfügen
targetRange.PasteSpecial Paste:=xlPasteAll

'Eingeblendeten Bereich wieder ausblenden
sourceRange.Hidden = True

' Auswahl aufheben
Application.CutCopyMode = False

' Meldung anzeigen
MsgBox "Bereich erfolgreich kopiert und eingefügt.", vbInformation

' UserForm schließen
Unload Me
End Sub

https://www.herber.de/bbs/user/170616.xlsm