Public Sub Verschieben()
Dim loLetzte As Long
Dim raBereich As Range
Dim raZelle As Range
Application.ScreenUpdating = False
With Sheets("Tabelle1")
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
Set raBereich = .Range(.Cells(1, 1), .Cells(loLetzte, 1))
For Each raZelle In raBereich
If raZelle.Value = "FROM" Then
raZelle.Offset(, 1).Value = raZelle.Value
raZelle.ClearContents
End If
Next raZelle
End With
Application.ScreenUpdating = True
End Sub
Gruß Werner