Sub removertf()
'
' removertf Makro
 
    Dim AnzahlZeilen As Long
    Dim Zeile As Long
    Dim str1 As String
    Dim strToFind As String
 
    AnzahlZeilen = ActiveSheet.UsedRange.Rows.Count
 
        For Zeile = 1 To AnzahlZeilen
 
            str1 = Cells(Zeile, 4).Value
            strToFind = "\fs"
            label1.Text = str1.IndexOf(strToFind, 2)
            TextBox2.Text = str1.Remove(0, CInt(label1.Text))
            Cells(Zeile, 5) = TextBox2.Text
 
        Next Zeile
 
End Sub

Sub FindString()
 
Dim wb As Workbook
Set wb = ActiveWorkbook
 
Dim ws As Worksheet
Set ws = wb.Sheets("Tabelle1")
 
Dim rg As Range
Set rg = ws.Range("D:D")
 
Dim Suchwert As String
Suchwert = "\fs"
 
Dim GefZelle As Object
Set GefZelle = rg.Find(What:=Suchwert)
 
Dim firstAddress As String
Dim strZellinhalt As String
 
With rg
    Set GefZelle = .Find(Suchwert)
    If Not GefZelle Is Nothing Then
    firstAddress = GefZelle.Address
        Do
                zellinhalt = Cells(GefZelle.Row, GefZelle.Column).Value
        Dim strErgebnis As String
        strErgebnis = BereinigeString(zellinhalt, Suchwert)
        Cells(GefZelle.Row, 5).Value = strErgebnis
            Set GefZelle = .FindNext(GefZelle)
            If GefZelle Is Nothing Then
                GoTo DoneFinding
            End If
            Loop While Not GefZelle Is Nothing And GefZelle.Address <> _
              firstAddress
    End If
DoneFinding:
MsgBox ("Die Suche ist beendet!")
End With
 
End Sub
 
Function BereinigeString(ByVal strText As String, ByVal Suchwert As String) As _
  String
 
Dim i As Integer
i = InStr(strText, Suchwert)
 
Dim retVal As String
retVal = Right(strText, Len(strText) - 93)
 
Dim j As Integer
j = InStr(retVal, "\par")
 
retVal = Left(retVal, j - 1)
 
BereinigeString = Trim(retVal)
 
End Function

EALA FREYA FRESENA