|
Hallo Chris,
Ja das ist möglich. Allerdings kenne ich natürlich dein System nicht. Kann dir daher nur den folgenden Code anbieten, der bei mir funktioniert.
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
Wenn du das Ganze aber über Button startest, sollte dieser in der Überschriftenzeile liegen. Andernfalls könnte er u.U. versehentlich mit rüberkopiert werden, falls die Zeile in der er liegt selbst auch zu den obsoleten gehört. Besser wäre ein Start über Symbolleiste, Shortcut oder direkt beim Öffnen der Datei.
Gruß Mr. K.
|