То есть нужен макрос, который создаёт папки из столбца 1 (имя ученика)
И в эти папки копирует файли с картинками.
На просторах интернета нашёл код, но не работает почему-то.
Подскажите, что нужно исправить и безопасен ли он?
- Код: Выделить всё
Sub Макрос()
Dim путь As String, ИмяФайла As String, ПапкаГород As String
Dim lr As Long, i As Long
'1. Запись в переменную пути.
путь = "C:\Users\User\Desktop\Фото"
'2. Поиск последней строки, в которой есть данные.
' End не ищет в скрытых строках.
lr = Cells(Rows.Count, "A").End(xlUp).Row
'3. Перемещение файлов в указанную папку.
' Движение по строкам со второй по последнюю.
For i = 2 To lr
'1) Копирование данных из экселя в переменные для удобства чтения кода.
' Запись города в переменную.
ПапкаГород = Cells(i, "A").value
' Запись имени файла в переменную.
ИмяФайла = Cells(i, "B").value
'2) Создание папки.
On Error Resume Next
MkDir путь & "\" & ПапкаГород
On Error GoTo 0
'3) Перемещение файла.
' Копирование файла.
FileCopy путь & "\" & ИмяФайла, путь & "\" & ПапкаГород & "\" & ИмяФайла
' Удаление файла.
Kill путь & "\" & ИмяФайла
Next i
'4. Сообщение.
MsgBox "Готово.", vbInformation
End Sub
