Sub Sebi1234()
Dim rng As Excel.Range
Dim wksNew As Excel.Worksheet
Dim v As Variant
v = Application.Match("# Stellen x*", Range("A:A"), 0)
Set rng = ActiveSheet.Cells(v, 1).CurrentRegion
With Intersect(rng, rng.Offset(1)).Copy
With ThisWorkbook
Set wksNew = .Worksheets.Add(after:=.Worksheets(.Sheets.Count))
wksNew.Name = "Name des neuen Worksheets"
End With
End With
wksNew.Cells(v, 1).PasteSpecial xlPasteAll
With Application
.CutCopyMode = False
.Goto Reference:=wksNew.Range("A1")
End With
End Sub