Копирование + переименование файлов.

Пользователь

Сообщений: 2 Регистрация: 20.03.2018

20.03.2018 22:22:58

Добрый вечер!

Я новичок в данном деле, так что если будет написана ( на ваш взгляд) какая-то глупость - извиняюсь.
Осваиваю потихоньку VBA по мере возможности для рабочих нужд.

Есть рабочая задача, которую не могу решить, надеюсь Вы поможете.

Имеется файл, назовем его Карточка.xlsx, который находится в одной папке, не имеет значения какой, но допустим "С:\Документы\Искомая папка"
Требуется копировать данный файл заданное число раз (приблизительно 620) и поместить в, скажем папку "С:\Документы\Искомая папка\Карточки".
При этом при копировании требуется и переименовать файл.
Имя файла можно взять, к примеру, из другого файла excel, со 2 столбца единственного листа книги.
Это 5-значный набор цифр, вроде 10010. Таких кодов приблизительно 620 (точное значение не помню).
Получается, что искомый файл требует "раскопировать" заданное число раз и каждый раз требуется ему присваивать новое имя из другого источника, что в папке "С:\Документы\Искомая папка\Карточки" по итогам находились эти файлы, к примеру 10010.xlsx, 10011.xlsx,.....10630.xlsx.

Буду признателен за Ваши советы.

Спасибо.

Yaroslav_T

Пользователь

Сообщений: 16 Регистрация: 01.01.1970

20.03.2018 22:59:03

Макрос нужно запускать при выделенном диапазоне с новыми названиями файлов
На всякий случай - очень хорошая справка по FSO

Код

Sub MultiCopy()

Dim path_from As String: path_from = "С:\Документы\Искомая папка\"
Dim path_to As String: path_to = "С:\Документы\Искомая папка\Карточки\"

Dim fn As String: fn = "Карточка.xlsx"

Dim cell As Range
Dim rng As Range: Set rng = Selection

Set FSO = CreateObject("Scripting.FileSystemObject")

For Each cell In rng
  FSO.CopyFile path_from & fn, path_to & cell.Value & ".xlsx", 0
Next cell

End Sub

Изменено: Yaroslav_T - 20.03.2018 23:00:54

Kamajul Пользователь Сообщений: 2 Регистрация: 20.03.2018	#3 20.03.2018 23:08:59 От всей души благодарю Вас! Спасибо вам огромное!