Guten Morgen,

danke erstmal für die Hilfe, den Löschvorgang habe ich drin. Nur das mit der Ausgabe funktioniert noch nicht ganz

hier erstmal der neue Code:

Private Sub CommandButton1_Click()

Dim Meldung         As Byte, Pos        As Byte
Dim Schleife        As Byte, y          As Byte
Dim Begriff, Suchen()                   As Variant
Dim Bereich                             As Range
Dim n%, x%, xZelle%, yZelle%
Dim xTabelle$(), Adresse$(), Text$

On Error Resume Next
Sheets("Startseite").Cells.Clear
On Error GoTo 0
' Suchbegriff eingeben
Begriff = InputBox _
("Bitte den zu suchenden Begriff eingeben. Sollen 2 Werte" & vbCrLf & _
 "gleichzeitig gesucht werden, dann mit Zeichen  +  " & vbCrLf & _
 "voneinander trennen (z.B.: Summe+die)." & vbCrLf & vbCrLf & _
 "ENTER ohne Wert = Abbruch", "S U C H M O D U S")
If Begriff = "" Then Exit Sub

Pos = InStr(Begriff, "+")
If Pos Then
    ReDim Suchen(2)
    Suchen(1) = Left(Begriff, Pos - 1)
    Suchen(2) = Right(Begriff, Len(Begriff) - Pos)
    Schleife = 2
Else
    ReDim Suchen(1)
    Suchen(1) = Begriff
    Schleife = 1
End If

Application.ScreenUpdating = False


' Eigentlicher Suchvorgang (in allen Tabellenblättern)
x = 1
For y = 1 To Schleife
  For n = 1 To Sheets.Count
  
  ' Letzte Zelle des Bereiches ermitteln. Diese Zelle wird als Startzelle für
  ' die Suche deffiniert, da Suche nach dieser Zelle, also in erster Zelle
  ' des Bereiches beginnt.
  'Bereich festlegen
  Set Bereich = Worksheets(n).UsedRange
  
  
  With Worksheets(n).Range(Bereich.Address)
      xZelle = .Columns(.Columns.Count).Column
      yZelle = .Rows(.Rows.Count).Row
  End With
  With Sheets(n).Range(Bereich.Address)
      Set c = .Find(Suchen(y), after:=Cells(yZelle, xZelle), LookIn:=xlValues)
      If Not c Is Nothing Then
          ErsteAdresse = c.Address
          Do
              ReDim Preserve Adresse(x): ReDim Preserve xTabelle(x)
              xTabelle(x) = Sheets(n).Name
              Adresse(x) = c.Address(RowAbsolute:=False, ColumnAbsolute:=False)
              Set c = .FindNext(c)
              x = x + 1
          Loop While Not c Is Nothing And c.Address <> ErsteAdresse
      End If
  End With
  Next n
Next y


Application.ScreenUpdating = True

' Die Anzahl der gefundenen Werte ist (x - 1), wenn keiner
' gefunden wurde dann ist x = 1
Select Case x
Case 1
    Meldung = MsgBox("Es wurde kein übereinstimmender Wert gefunden", _
    vbOKOnly, "G E F U N D E N E   W E R T E")
    Exit Sub
Case Else
    Meldung = MsgBox("Es wurden " & (x - 1) & " Übereinstimmungen gefunden.", _
    vbOKOnly, "G E F U N D E N E   W E R T E")
'Tabelle einfügen
'Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
On Error Resume Next
With ActiveSheet
    .Name = "Startseite"
    .[I5] = "Suchergebnis"
    

    For n = 1 To x - 1
        .Cells(n + 7, 9) = xTabelle(n)
        .Cells(n + 7, 10) = Begriff
        Next n
End With
End Select


End Sub

hier ein Beispiel

ich suche jetzt zum Beispiel nach m1,6 (funktioniert auch), ausgeben möchte ich jetzt nur wie gesagt alles. Sprich alle auflisten wo M1,6 vor kommt

und dann die ganzen Zeilen.