Für den nachfolgenden Code möchte ich mich ganz herzlich bei Gast8161 (ralf_b) bedanken und bei der KI dir mir dabei geholfen hat.
 

Dim oldValue As String
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim rngDropdown As Range
    Dim dataRange As Range
    Dim cell As Range
     
    ' Arbeitsblatt festlegen
    Set ws = ThisWorkbook.Worksheets("Eingabedialog") ' Passen Sie den Blattnamen entsprechend an
     
    ' Bereich der Dropdown-Liste festlegen
    Set rngDropdown = ws.Range("G4") ' Passen Sie die Dropdown-Zelle entsprechend an
     
    ' Überprüfen, ob die Änderung im Dropdown-Feld erfolgt ist
    If Not Intersect(Target, rngDropdown) Is Nothing Then
        ' Wenn der Wert in der Dropdown-Liste gelöscht wird
        If Target.Value = "" Then
            ' Datenbereich der Tabelle festlegen (z.B., A3:G100)
            Set dataRange = ThisWorkbook.Worksheets("Rohdaten").Range("A3:G" & ThisWorkbook.Worksheets("Rohdaten").Cells(ThisWorkbook.Worksheets("Rohdaten").Rows.Count, "A").End(xlUp).Row) ' Passen Sie den Bereich der Tabelle entsprechend an
             
            ' Durchsuchen Sie den Datenbereich, um die Zeile zu finden, die gelöscht werden soll
            For Each cell In dataRange
                If cell.Value = oldValue Then
                    ' Zeile löschen
                    cell.EntireRow.Delete
                     
                    ' Datenquelle der Dropdown-Liste aktualisieren
                    UpdateDropdown ws, rngDropdown, dataRange
                     
                    MsgBox "Eintrag und entsprechende Zeile wurden gelöscht."
                    Exit Sub
                End If
            Next cell
             
            MsgBox "Der ausgewählte Eintrag wurde in der Tabelle nicht gefunden."
        Else
            ' Speichern Sie den aktuellen Wert als alten Wert
            oldValue = Target.Value
        End If
    End If
     
    ' Überprüfen, ob die Änderung in der Dropdown-Liste (Zelle G4) des Tabellenblatts "Blatt1" stattgefunden hat
    If Target.Address(0, 0) = "G4" And Target.Value <> "" Then
        selectedOption = Me.Range("G4").Value
        With Sheets("Rohdaten")
            ' Suche nach der ausgewählten Option in der ersten Spalte
            searchData = Application.Match(selectedOption, .Columns(1), 0)
             
            If IsNumeric(searchData) Then
                ' Wenn die Option gefunden wurde, übertrage die Daten in J13:J17
                Application.EnableEvents = False
                Me.Range("J13:J17") = WorksheetFunction.Transpose(.Cells(searchData, 2).Resize(1, 5))
                Application.EnableEvents = True
            Else
                ' Wenn die Option nicht gefunden wurde, füge sie als neue Zeile hinzu
                lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                .Cells(lastRow, 1).Value = selectedOption
                Application.EnableEvents = False
                Me.Range("J13:J17").ClearContents
                Application.EnableEvents = True
            End If
        End With
    Else
        ' Überprüfe, ob die Änderung in dem Bereich J13:J17 stattgefunden hat
        If Not Intersect(Target, Me.Range("J13:J17")) Is Nothing Then
            If Me.Range("G4").Value <> "" Then
                With Sheets("Rohdaten")
                    searchData = Application.Match(Me.Range("G4").Value, .Columns(1), 0)
                    If IsNumeric(searchData) Then
                        .Cells(searchData, 2).Resize(1, 5).Value = WorksheetFunction.Transpose(Me.Range("J13:J17").Value)
                    End If
                End With
            End If
        End If
    End If
End Sub
 
Sub UpdateDropdown(ws As Worksheet, rngDropdown As Range, dataRange As Range)
    Dim uniqueValues As Collection
    Dim cell As Range
    Dim arr() As String
    Dim i As Long
     
    ' Sammlung einzigartiger Werte erstellen
    Set uniqueValues = New Collection
    On Error Resume Next
    For Each cell In dataRange
        If cell.Value <> "" Then
            uniqueValues.Add cell.Value, CStr(cell.Value)
        End If
    Next cell
    On Error GoTo 0
     
    ' Überprüfen, ob die Sammlung einzigartige Werte enthält
    If uniqueValues.Count > 0 Then
        ' Sammlung in Array umwandeln
        ReDim arr(1 To uniqueValues.Count)
        For i = 1 To uniqueValues.Count
            arr(i) = uniqueValues(i)
        Next i
         
        ' Dropdown-Liste aktualisieren
        With rngDropdown.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=Becken" ' Verwenden Sie den Namensbereich "Becken" als Quelle für die Dropdown-Liste
            .IgnoreBlank = True
            .InCellDropdown = True
            .ShowInput = True
            .ShowError = True
        End With
    Else
        ' Falls keine eindeutigen Werte vorhanden sind, Dropdown-Liste leeren
        With rngDropdown.Validation
            .Delete
        End With
    End If
End Sub