1162 подписчика

Макрос сохраняющий отдельным файлом текущий лист в новую папку

7 сентября 20207 сен 2020

763

1 мин

Этот макрос сохраняет текущий лист отдельным файлом в новую папку. Папка с новым файлом создается в месте хранения текущей книги. Название папки соответствует имени ярлыка сохраняемого листа, файл имени ярлыка и дате сохранения.

Копируйте код и сохраните его в Личной книге макросов.

Sub SaveSheetInFolderToFile()

Dim bookconst As Workbook

Set bookconst = Workbooks(ActiveWorkbook.Name)

'Убираем мерцание

Application.ScreenUpdating = False

'Копируем активный лист

ActiveSheet.Copy

'Присваиваем переменные имени будущего файла и расположения книги

Dim sName, fAdres As Variant

sName = ActiveSheet.Name

fAdres = bookconst.Path

'Проверяем папку на наличие папки с таким именем, если нет создаем

If Len(Dir(fAdres & "\" & sName, vbDirectory)) = 0 Then 'проверяем наличие папки

MkDir fAdres & "\" & sName 'создаём папку

End If

'Сохраняем файл Имя листа + дата

ActiveWorkbook.SaveAs Filename:=fAdres & "\" & sName & "\" & sName & "_" & Date & ".xlsx"

Application.ScreenUpdating = True

ActiveWorkbook.Close

End Sub

Открыть редактор VBA Alt +F11:

Вызвать меню для выполнения или изменения макросов Alt + F8:

На выполнение макроса можно назначить "Горячие клавиши", нажав в окне Параметры:

В поле Сочетание клавиш введите прописные или строчные буквы, которые вы хотите использовать. Важен регистр и язык. Нельзя назначить макрос на функциональные клавиши Excel.

Для Windows сочетание клавиш для строчных букв — Ctrl + буква. Для прописных букв — Ctrl + Shift + БУКВА.
Для Mac сочетание клавиш для строчных букв — Option + Command + буква или Ctrl + буква. Для прописных букв — Ctrl + Shift + буква.