Рандомное переименование файлов txt без повторов - VBA

Формулировка задачи:

Добрый день. Помогите с задачей. В одной папке с книгой - есть txt файлы, с названиями 1.txt, 2.txt, 3.txt и т.д. Как нажатием на кнопку макроса - поменять названия файлов случайным образом - используя те же самые числовые данные? В итоге - получится что файлы вроде бы те же самые... но их названия ПЕРЕТАСОВАНЫ. Например файл который при запуске макроса - назывался 2.txt - после срабатывания - будет называться 5.txt или 11.txt (в названии файлов - всегда только числа). Названия файлов - могут быть только те, что существуют в папке на момент запуска скрипта. То есть - если в папке с книгой всего 11 текстовых файлов, то при переименовании - не может быть файла с названием 14 или 15.

Решение задачи: «Рандомное переименование файлов txt без повторов»

textual
                            Листинг программы 
                        

                            Sub Перетасовать_Названия_файлов()
    Dim i&, j&, v, c As New Collection
    On Error Resume Next
    With CreateObject("scripting.filesystemobject")
        Randomize Timer
        For Each v In .getfolder(ThisWorkbook.Path).Files
            If LCase(Right$(v, 4)) = ".txt" Then c.Add v.Path
        Next
        
        For i = 1 To c.Count
            .MoveFile c(i), ThisWorkbook.Path & "\" & i * 1000 & ".txt"
        Next
    
        For Each v In .getfolder(ThisWorkbook.Path).Files
            If LCase(Right$(v, 4)) = ".txt" Then
                j = Fix(Rnd * c.Count) + 1
                .MoveFile v.Path, c(j)
                c.Remove (j)
            End If
        Next
    End With
 
End Sub
                        