Private Sub Command1_Click()
On Error Resume Next
 
    lngValue = 1000                             ' legt fest in welchem bereich 
    ' gearbeitet wird
    lngMod = lngValue                           ' gibt den aktuellen bereich 
    ' wieder
    strPthWatch = "C:\temp\XXX\"                ' in diesem pfad wird nach 
    ' neuen bildern gesucht, das abschließende Backslash nicht vergessen
    strPthCopy = "C:\Bilder\"          ' in diesem pfad werden die neuen ordner 
    ' erstellt
 
    Dim FileStructur As SHFILEOPSTRUCT          ' Datei Struktur
    FileStructur.wFunc = FN_MOVE                ' Dateien verschieben ( 
    ' kopieren=&H2)
    FileStructur.fFlags = SHF_FLAGS             ' SHF_SILENT Or 
    ' SHF_RENAMEONCOLLISION Or SHF_FILESONLY Or SHF_ALLOWUNDO Or 
    ' SHF_NOCONFIRMATION
 
    MkDir strPthCopy                            ' Ordner für Sammlung erstellen
 
    Debug.Print "los gehts"                     ' eine meldung im debug window
 
    strPthActive = Dir$(strPthWatch)            ' erste datei einlesen
    Do While Len(strPthActive)                  ' solange es dateien gibt
       ' dateiname extrahieren
       strFile = Left$(strPthActive, InStr(strPthActive, ".") - 1)
       ' dateierweiterung extrahieren
       strExt = Right$(strPthActive, Len(strPthActive) - InStr(strPthActive, _
         "."))
       If IsNumeric(strFile) Then               ' wenn der dateiname eine zahl 
       ' ist, das sollte er sein!
        lngFile = CLng(strFile) - 1             ' name zum berechnen 
        ' konvertieren
        If lngFile < lngValue Then              ' wenn kleiner/gleich bereich
                                                ' diese Ordner Struktur
            strDest = strPthCopy & "Bilder 1 bis " & lngValue
        Else                                    ' wenn nicht
                                                ' Ordner bereich ermitteln
            lngMod = lngValue + (Int(lngFile / lngValue) * lngValue)
            strDest = strPthCopy & "Bilder " & lngMod - lngValue + 1 & " bis " _
              & lngMod
        End If
        MkDir strDest                           ' Order erstellen
        ' das muss nicht sein aber naja man will ja wissen wo man steht
        Caption = strPthActive & " -> " & strDest
        DoEvents                                ' Events, ermöglicht das 
        ' abbrechen usw.
        If blnCancel Then Exit Do               ' schon Abgebrochen ?
        ' der folgende code setzt die variablen und ersetzt NullChars
        strSource = strPthWatch & strPthActive
        strSource = Replace$(strSource, vbNullChar, vbNullString)
        strDest = Replace$(strDest, vbNullChar, vbNullString)
        ' hier wird die struktur neu gefüllt pfade mit abschließender Null
        FileStructur.pFrom = strSource & vbNullChar
        FileStructur.pTo = strDest & vbNullChar
        ' operation...
        lngRet = SHFileOperation(FileStructur)
        If lngRet = 0 Then
            ' operation gelungen, patient tot !
        End If
       End If
       strPthActive = Dir$                      ' nächste datei
    Loop
    blnCancel = False                           ' Abbrechen-Wert zurücksetzen
 
Debug.Print "done"
End Sub
 
Private Sub Command2_Click()
    blnCancel = True                            ' bitte abbrechen
End Sub

Ohne Mampf, kein Kampf !