This is how I solved it, eventually. It does run a very long time!

[VBA]
Option Compare Text
Option Explicit
Global FSO As Object
Global ShellApp As Object
Global file As Object
Global SubFolder As Object
Global Directory As String
Global srcDirectory As String
Global Problem As Boolean
Global ExcelVer As Integer
Global PATH_START As String
Global f As Long
Global rowIndex As Long
Global newpath As String
Global oldpath As String
Global interfaceFile As String
Global EOF As Boolean
Global n As Long
Sub HyperlinkFileList()
Dim Preface As String
Dim i As Long

'Turn off screen flashing
Application.ScreenUpdating = True

Set FSO = CreateObject("Scripting.FileSystemObject")
interfaceFile = Application.ActiveWorkbook.Path + "\List Directory.xls"

'Prompt user to select a directory
Do
Problem = False
Set ShellApp = CreateObject("Shell.Application"). _
Browseforfolder(0, "Kies een bron directory", 0, "x:\\")

On Error Resume Next
'Evaluate if directory is valid
Directory = ShellApp.self.Path & "\"
srcDirectory = ShellApp.self.Path
Set SubFolder = FSO.Getfolder(Directory).Files
If Err.Number <> 0 Then
If MsgBox("U hebt een ongeldige directory gekozen!" & vbCrLf & _
"Wil U nogmaals proberen?", vbYesNoCancel, _
"Directory Benodigd") <> vbYes Then Exit Sub
Problem = True
End If
On Error GoTo 0
Loop Until Problem = False

PATH_START = srcDirectory
ListFiles
'// Created a reference to FileSystemObject; see vba help. //
Set FSO = CreateObject("Scripting.FileSystemObject")

Preface = "deel"

i = 1
rowIndex = 1
EOF = False

'f = 0

Do
If Not FSO.FolderExists(PATH_START & "\" & Preface & i) Then
FSO.CreateFolder (PATH_START & "\" & Preface & i)
Directory = (PATH_START & "\" & Preface & i)
End If
Directory = (PATH_START & "\" & Preface & i)
'f = f + 1
n = 0
MoveFiles
i = i + 1

Loop Until EOF
'MoveFiles

End Sub
Sub ListFiles()
Dim oFolder As Object
Dim oFile As Object
Dim kk25 As Integer

Set oFolder = FSO.Getfolder(PATH_START)

'Lists all the files in the current directory

kk25 = 1

For Each oFile In oFolder.Files
Worksheets("Blad1").Cells(kk25, 1).Value = oFile.Name

kk25 = kk25 + 1
Next

End Sub
Sub MoveFiles()
Dim ws As Worksheet
Dim fileNaam As String
Dim wb As Workbook

Set wb = ActiveWorkbook
'Set wb = Application.ActiveWorkbook.Name
'wb.Activate
Set ws = wb.Worksheets(1) 'hardcoded!

On Error GoTo FileCopyError

Set FSO = CreateObject("Scripting.FileSystemObject")
newpath = Directory & "\"
oldpath = srcDirectory & "\"

'rowIndex = 5
f = 1
Do
'Copy to shared folder
fileNaam = ws.Cells(rowIndex, 1)
If fileNaam = "" Then
EOF = True
Else
FSO.CopyFile oldpath & fileNaam, newpath & fileNaam
rowIndex = rowIndex + 1
f = f + 1
End If

Loop Until EOF Or f > 200

Exit Sub

FileCopyError:
MsgBox "Er is een probleem opgetreden met het copiëren de bestanden"
End

End Sub

[/VBA]