Sub Verschieben()
ordner = "E:\Norbert2\Daten\Tests\Mitarbeiterliste"
zielordner = "E:\Norbert2\Daten\Tests\Mitarbeiterliste\ausgeschiedene Mitarbeiter"
zielblatt = "ausgeschiedene Mitarbeiter"
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(ordner)
If Right(zielordner, 1) <> "\" Then zielordner = zielordner + "\"
If ActiveSheet.Name = zielblatt Then Exit Sub
For z = 2 To Cells(Rows.Count, 10).End(xlUp).Row
If Cells(z, 7) <> "" And Cells(z, 7) <= Date Then
For Each sf In f.SubFolders
o = sf & "\" & Cells(z, 10)
If fs.fileexists(o) Then
fs.movefile o, zielordner
End If
Next
Rows(z).Cut
Sheets(zielblatt).Cells(Rows.Count, 10).End(xlUp) _
.Offset(1, 0).EntireRow.Insert Shift:=xlDown
If Cells(z, 10) = "" Then Rows(z).Delete Shift:=xlUp
z = z - 1
End If
Next z
End Sub