Option Explicit
Sub Makro1()
Dim loLetzte As Long, i As Long
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
loLetzte = .Cells(.Rows.Count, "B").End(xlUp).Row
.Range(.Cells(2, "B"), .Cells(loLetzte, "B")).Replace What:="< ", Replacement:="", LookAt:=xlPart
For i = 2 To loLetzte
.Cells(i, "B") = .Cells(i, "B") * 1000
.Cells(i, "B") = "< " & .Cells(i, "B")
Next i
End With
End Sub