Hallo Wolfgang,

das nach der Linie in ein Modul im Excel kopieren.
Mit der Function START, werden deine Dateien gesucht und in Spalte A, im Excel, aufgeschrieben.
In Spalte B wird der neue Pfad ohne den Ordner Video aufgeschrieben.

Mit der Function Start_umbennen änders du die Dateien ab. Diese werden jetzt verschoben.

(Ein Function kannst du mit F5 starten. Achtung! Vorher in die zu funktion klicken.)

Bevor du die Dateien verschiebst, schau den Pfad in Spalte B an, damit der auch passt.


Alle_Daten = S_Dateisuche("S:\TEMP\", "*.avi") --> hier musst du anpassen, welche dateien gesucht werden sollen und in 
welchen Ordner alles liegt.. 




avi.. mkv usw.

Die VIDEO Ordner könntest du im anschluss auch über die Windowssuche löschen.

Oder man schreibt noch nen code, der leere Ordner löscht...



__________________________________________________________________________
Option Explicit

Dim DateinamenFeld() As Variant
Dim DateinamenZähler As Long
Dim DateinamenLast As String

Function START()
Dim Alle_Daten As Variant
Dim L As Long
Application.ScreenUpdating = False
Alle_Daten = S_Dateisuche("S:\TEMP\", "*.avi")
With ActiveSheet
    on error resume next
    For L = 1 To UBound(Alle_Daten)
        .Range("A" & L) = Alle_Daten(L)
        .Range("B" & L) = Replace(Alle_Daten(L), "\VIDEO", "")
    Next L
    on error goto 0
End With
Application.ScreenUpdating = True
MsgBox "fertig"
End Function

Function Start_umbennen()
Dim L As Long
Dim LZ As Long
Dim Namealt As String
Dim Nameneu As String
Application.ScreenUpdating = False
With ActiveSheet
    LZ = ActiveSheet.Cells(1048576, 1).End(xlUp).Row
    For L = 1 To LZ
        Namealt = .Range("A" & L)
        Nameneu = .Range("B" & L)
        Name Namealt As Nameneu
    Next L
End With
Application.ScreenUpdating = True
MsgBox "fertig"
End Function




Function S_Dateisuche(Ordnerpfad As String, Dateiname_Endung As String) As Variant
DateinamenZähler = 0
Erase DateinamenFeld
If Dir(Ordnerpfad, vbDirectory) <> "" Then
    Dateisuche Ordnerpfad, Dateiname_Endung
    Schreiben Ordnerpfad
    S_Dateisuche = DateinamenFeld
Else
    ReDim DateinamenFeld(0)
    DateinamenFeld(0) = ""
    S_Dateisuche = DateinamenFeld
End If
End Function
Private Function Dateisuche(Ordnerpfad As String, Dateiname_Endung As String)
Dim Dateiname As String
DateinamenLast = Dateiname_Endung
If Right(Ordnerpfad, 1) <> "\" Then Ordnerpfad = Ordnerpfad & "\"
Dateiname = Dir(Ordnerpfad & Dateiname_Endung)
Do Until Dateiname = ""
    DoEvents
    ReDim Preserve DateinamenFeld(DateinamenZähler)
    DateinamenFeld(DateinamenZähler) = Ordnerpfad & Dateiname
    DateinamenZähler = DateinamenZähler + 1
    Dateiname = Dir
Loop
End Function
Private Function Schreiben(Suchordner)
Dim FSO As Object
Dim Ordner
Dim Unterordner
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Ordner = FSO.GetFolder(Suchordner)
On Error Resume Next
    For Each Unterordner In Ordner.SubFolders
        DoEvents
        Dateisuche Unterordner.Path, DateinamenLast
        Schreiben Unterordner
    Next
Set FSO = Nothing
Set Ordner = Nothing
End Function