- etwas erklären, dass ohnedies schon Makulatur wenn der User auf Beitrag erstellen klickt?

Da prüfe ich flexibel besser die Dateien im Verzeichnis auf Übereinstimmung im Arbeitsblatt

Option Explicit
'
'vorbelegen Quellordner
Const zvPfad As String = "C:\Warenkorb\Zu_Verkaufen\"
Const zkPfad As String = "C:\Warenkorb\Zu_Kaufen\"
'vorbelegen Zielordner
Const vPfad As String = "C:\Warenkorb\Verkauft\"
Const gPfad As String = "C:\Warenkorb\Gekauft\"
'vorbelegen Teilstring
Const charleft As Integer = 10
'vorbelegen Spalten wo
Const shortname As Long = 12
Const saledstat As Long = 17

Sub DoIt()
Dim arrFiles() As Variant  'Dateiliste
Dim i As Integer
'
   'Dateien in den Quellordner(n)
   On Error Resume Next
   arrFiles = listfiles(zvPfad, zkPfad)
   If Err.Number Then
      Call MsgBox("leere oder falsche Ordner", vbExclamation, "Abbruch")
      Exit Sub
   End If
   On Error GoTo 0
   
   'wir triggern "Gekauft" über "C:\Warenkorb\Zu_Verkaufen\"
   'die Liste aller Dateien sucht sich in Spalte shortname ob gekauft
   arrFiles = chkhits(arrFiles, shortname, saledstat, "Gekauft", zvPfad, gPfad)
      
   'wir triggern "Verkauft" über "C:\Warenkorb\Zu_Kaufen\"
   'die Liste aller Dateien sucht sich in Spalte shortname ob verkauft
   arrFiles = chkhits(arrFiles, shortname, saledstat, "Verkauft", zkPfad, vPfad)
   
   'Verschiebung
   For i = LBound(arrFiles, 1) To UBound(arrFiles, 1)
      'nur die Felder mit Pfad
      If InStr(arrFiles(i, 1), ":\") > 0 Then _
         Name arrFiles(i, 1) As arrFiles(i, 2)
   Next i
   
End Sub

Private Function chkhits(aFiles As Variant, clTerm As Long, clHit As Long, _
strHit As String, fFolder As String, tFolder As String)
Dim x As Long
Dim aList() As Variant
Dim rngHit As Range
Dim clDiff As Long
Dim strName As String

   'Liste der Begriffe umschreiben
   aList = aFiles
   'Spaltenabstand
   clDiff = clHit - clTerm
   'Makro startet im Arbeitsblatt mit den Vorgaben
   With ActiveSheet.Columns(clTerm)
      For x = LBound(aList, 1) To UBound(aList, 1)
         'nur wenn noch kein Ordner eingetragen
         If InStr(aList(x, 1), ":\") = 0 Then
            'Teilstring in benannter Spalte suchen
            Set rngHit = .Find(aList(x, 2), , -4163, 2)
            If Not rngHit Is Nothing Then
               'Abgleich mit Vorgabe
               If rngHit.Offset(, clDiff).Value <> strHit Then
                  'Quellpfad und Zielpfad
                  strName = aList(x, 1)
                  aList(x, 1) = fFolder & strName
                  aList(x, 2) = tFolder & strName
               End If
            End If
         End If
      Next x
   End With
   'an die aufrufende Liste zurückgeben
   chkhits = aList

End Function

Private Function listfiles(ByVal zk As String, vk As String)
'thx to Justin Mosser https://www.chippergolf.com/

Dim vaArray     As Variant
Dim i           As Integer
Dim s           As Integer
Dim oFile       As Object
Dim oFSO        As Object
Dim oFolder     As Object
Dim oFiles      As Object

   Set oFSO = CreateObject("Scripting.FileSystemObject")
   'Anzahl Dateien in den Ordner(n)
   Set oFolder = oFSO.GetFolder(zk)
   Set oFiles = oFolder.Files
   s = oFiles.Count
   Set oFolder = oFSO.GetFolder(vk)
   Set oFiles = oFolder.Files
   s = s + oFiles.Count
   If s = 0 Then Exit Function
   
   'Array mit Dateinamen und Teilstring dazu
   ReDim vaArray(1 To s, 1 To 2)
   'aus dem aktuel betrachteten Verzeichnis
   For Each oFile In oFiles
      i = i + 1
      vaArray(i, 1) = oFile.Name
      vaArray(i, 2) = Left(oFile.Name, charleft)
   Next
   'aus dem zuerst betrachteten Verzeichnis dazu
   Set oFolder = oFSO.GetFolder(zk)
   Set oFiles = oFolder.Files
   For Each oFile In oFiles
      i = i + 1
      vaArray(i, 1) = oFile.Name
      vaArray(i, 2) = Left(oFile.Name, charleft)
   Next
   'an die aufrufende Liste zurückgeben
   listfiles = vaArray

End Function