Коллеги, добрый день , использую макрос , чтобы сохранять каждую вкладку как отдельный файл и в отдельной папке с сохранением названия, но есть такая проблема, если я использую другой файл , а там есть такая же вкладка с таким же названием, то нельзя сохранить это, ибо выскакивает ошибка , ну знаете стандартная, заменить ли файл с таким же названием, так вот, хочу как то подправить макрос так, чтобы когда был файл с идентичным названием в данной папке, он просто добавлял к названию например цифру (1) или (2), например есть в папке уже папка с названием TKRU12345 , и вот я делю эксель файл и там есть вкладка с таким же номером, и хочу чтобы макрос сохранял файл в данной папке, но не заменяя существующую, например вставлял в название TKRU12345 (1) , затем TKRU12345(2) и тд. Ниже прикреплю макрос который использую, для разделения вкладок в файле на каждый отдельный файл с созданием папки. Если я как то плохо обьяснил , вот еще раз, у меня есть два файла , в нем вкладки, макрос сохраняет каждую вкладку как отдельный файл, с сохранением названия вклакди, а так же создает для каждой вкладки папку, с таким же названием, и вот мне нужно, чтобы когда я начинал делить второй файл, где такие же названия, нужно его делить в эту же папку, но там уже существуют названия, и хочу чтобы он просто добавлял цифру к существующему, ниже макрос , который я использую, плиз ХЕЛП
[vba]
Код
Sub Разбивка() ' Макрос создаёт новые книги с содержимом исходной (активной) книги и сохраняет их по названиям листов в изначальной (активной) книге '' Количество новых книг = количеству листов в изначальной (активной) книге и является переменной величиной ''' Изначальная (активная) книга должна быть сохранена хотя бы раз '''' Новые книги сохраняются по тому же пути, где и расположен исходный файл
Application.ScreenUpdating = False
Dim ws As Worksheet Dim wb As Workbook Set wb = ActiveWorkbook Dim sPath
For Each ws In wb.Worksheets sPath = wb.path & "\" & ws.name If Dir$(sPath, vbDirectory) = "" Then MkDir (sPath) ws.Copy With ActiveWorkbook .SaveAs sPath & "\" & ws.name & ".xlsx", 51 .Close End With Next
End Sub
[/vba]
Коллеги, добрый день , использую макрос , чтобы сохранять каждую вкладку как отдельный файл и в отдельной папке с сохранением названия, но есть такая проблема, если я использую другой файл , а там есть такая же вкладка с таким же названием, то нельзя сохранить это, ибо выскакивает ошибка , ну знаете стандартная, заменить ли файл с таким же названием, так вот, хочу как то подправить макрос так, чтобы когда был файл с идентичным названием в данной папке, он просто добавлял к названию например цифру (1) или (2), например есть в папке уже папка с названием TKRU12345 , и вот я делю эксель файл и там есть вкладка с таким же номером, и хочу чтобы макрос сохранял файл в данной папке, но не заменяя существующую, например вставлял в название TKRU12345 (1) , затем TKRU12345(2) и тд. Ниже прикреплю макрос который использую, для разделения вкладок в файле на каждый отдельный файл с созданием папки. Если я как то плохо обьяснил , вот еще раз, у меня есть два файла , в нем вкладки, макрос сохраняет каждую вкладку как отдельный файл, с сохранением названия вклакди, а так же создает для каждой вкладки папку, с таким же названием, и вот мне нужно, чтобы когда я начинал делить второй файл, где такие же названия, нужно его делить в эту же папку, но там уже существуют названия, и хочу чтобы он просто добавлял цифру к существующему, ниже макрос , который я использую, плиз ХЕЛП
[vba]
Код
Sub Разбивка() ' Макрос создаёт новые книги с содержимом исходной (активной) книги и сохраняет их по названиям листов в изначальной (активной) книге '' Количество новых книг = количеству листов в изначальной (активной) книге и является переменной величиной ''' Изначальная (активная) книга должна быть сохранена хотя бы раз '''' Новые книги сохраняются по тому же пути, где и расположен исходный файл
Application.ScreenUpdating = False
Dim ws As Worksheet Dim wb As Workbook Set wb = ActiveWorkbook Dim sPath
For Each ws In wb.Worksheets sPath = wb.path & "\" & ws.name If Dir$(sPath, vbDirectory) = "" Then MkDir (sPath) ws.Copy With ActiveWorkbook .SaveAs sPath & "\" & ws.name & ".xlsx", 51 .Close End With Next
Просто нужно к имени сохраняемого файла (имени листа) добавлять дату сохранения с точностью до секунды. Вряд ли Вы будете сохранять чаще, чем 1 раз в секунду, но в принципе можно и с большей точностью. Тогда и разобрать по "возрасту" сохранённые файлы будет проще. Ну и после того, как Вы отключили обновление экрана, лучше на всякий случай его всё-таки включать после выполнения операций. При корректном завершении процедуры оно включится само, а если по выходу в отладчик, то могут возникнуть неприятные эффекты. Не проверял, но примерно так:
[vba]
Код
Sub Разбивка() ' Макрос создаёт новые книги с содержимом исходной (активной) книги и сохраняет их по названиям листов в изначальной (активной) книге '' Количество новых книг = количеству листов в изначальной (активной) книге и является переменной величиной ''' Изначальная (активная) книга должна быть сохранена хотя бы раз '''' Новые книги сохраняются по тому же пути, где и расположен исходный файл, но с добавлением суффикса - даты и времени сохранения
Application.ScreenUpdating = False
Dim Ws As Worksheet Dim sPath$ Dim sSuff$: sSuff = " ((" & Format(Now, "yyyy.mm.dd hh-mm'ss''") & "))" ' суффикс к имени файла копии - дата и время сохренения копии файла Dim Wb As Workbook Set Wb = ActiveWorkbook
For Each Ws In Wb.Worksheets sPath = Wb.Path & "\" & Ws.Name If Dir$(sPath, vbDirectory) = "" Then MkDir (sPath) Ws.Copy With ActiveWorkbook .SaveAs sPath & "\" & Ws.Name & sSuff & ".xlsx", 51 .Close End With Next Application.ScreenUpdating = True
End Sub
[/vba]
Просто нужно к имени сохраняемого файла (имени листа) добавлять дату сохранения с точностью до секунды. Вряд ли Вы будете сохранять чаще, чем 1 раз в секунду, но в принципе можно и с большей точностью. Тогда и разобрать по "возрасту" сохранённые файлы будет проще. Ну и после того, как Вы отключили обновление экрана, лучше на всякий случай его всё-таки включать после выполнения операций. При корректном завершении процедуры оно включится само, а если по выходу в отладчик, то могут возникнуть неприятные эффекты. Не проверял, но примерно так:
[vba]
Код
Sub Разбивка() ' Макрос создаёт новые книги с содержимом исходной (активной) книги и сохраняет их по названиям листов в изначальной (активной) книге '' Количество новых книг = количеству листов в изначальной (активной) книге и является переменной величиной ''' Изначальная (активная) книга должна быть сохранена хотя бы раз '''' Новые книги сохраняются по тому же пути, где и расположен исходный файл, но с добавлением суффикса - даты и времени сохранения
Application.ScreenUpdating = False
Dim Ws As Worksheet Dim sPath$ Dim sSuff$: sSuff = " ((" & Format(Now, "yyyy.mm.dd hh-mm'ss''") & "))" ' суффикс к имени файла копии - дата и время сохренения копии файла Dim Wb As Workbook Set Wb = ActiveWorkbook
For Each Ws In Wb.Worksheets sPath = Wb.Path & "\" & Ws.Name If Dir$(sPath, vbDirectory) = "" Then MkDir (sPath) Ws.Copy With ActiveWorkbook .SaveAs sPath & "\" & Ws.Name & sSuff & ".xlsx", 51 .Close End With Next Application.ScreenUpdating = True
Коллеги, подскажите пожалуйста, у меня есть макрос , он делит вкладки в файле на отдельные файлы, но мне необходимо чтобы макрос добавлял к наименованию точную дату до милисекунд, подскажите как это сделать
[vba]
Код
Sub Разбивка() ' Макрос создаёт новые книги с содержимом исходной (активной) книги и сохраняет их по названиям листов в изначальной (активной) книге '' Количество новых книг = количеству листов в изначальной (активной) книге и является переменной величиной ''' Изначальная (активная) книга должна быть сохранена хотя бы раз '''' Новые книги сохраняются по тому же пути, где и расположен исходный файл
Application.ScreenUpdating = False
Dim ws As Worksheet Dim wb As Workbook Set wb = ActiveWorkbook
For Each ws In wb.Worksheets ws.Copy ActiveWorkbook.SaveAs wb.Path & "\" & ws.Name & ".xlsx" Next
End Sub
[/vba]
Коллеги, подскажите пожалуйста, у меня есть макрос , он делит вкладки в файле на отдельные файлы, но мне необходимо чтобы макрос добавлял к наименованию точную дату до милисекунд, подскажите как это сделать
[vba]
Код
Sub Разбивка() ' Макрос создаёт новые книги с содержимом исходной (активной) книги и сохраняет их по названиям листов в изначальной (активной) книге '' Количество новых книг = количеству листов в изначальной (активной) книге и является переменной величиной ''' Изначальная (активная) книга должна быть сохранена хотя бы раз '''' Новые книги сохраняются по тому же пути, где и расположен исходный файл
Application.ScreenUpdating = False
Dim ws As Worksheet Dim wb As Workbook Set wb = ActiveWorkbook
For Each ws In wb.Worksheets ws.Copy ActiveWorkbook.SaveAs wb.Path & "\" & ws.Name & ".xlsx" Next
Sub Разбивка() ' Макрос создаёт новые книги с содержимом исходной (активной) книги и сохраняет их по названиям листов в изначальной (активной) книге '' Количество новых книг = количеству листов в изначальной (активной) книге и является переменной величиной ''' Изначальная (активная) книга должна быть сохранена хотя бы раз '''' Новые книги сохраняются по тому же пути, где и расположен исходный файл
Application.ScreenUpdating = False
Dim ws As Worksheet Dim wb As Workbook Set wb = ActiveWorkbook
For Each ws In wb.Worksheets ws.Copy ActiveWorkbook.SaveAs wb.Path & "\" & ws.Name & " " & Format(Now, "yyyy.mm.dd hh-mm-ss") & Right(Format(Timer, "0.000"), 4) & ".xlsx", 51 Next
End Sub
[/vba]
[vba]
Код
Sub Разбивка() ' Макрос создаёт новые книги с содержимом исходной (активной) книги и сохраняет их по названиям листов в изначальной (активной) книге '' Количество новых книг = количеству листов в изначальной (активной) книге и является переменной величиной ''' Изначальная (активная) книга должна быть сохранена хотя бы раз '''' Новые книги сохраняются по тому же пути, где и расположен исходный файл
Application.ScreenUpdating = False
Dim ws As Worksheet Dim wb As Workbook Set wb = ActiveWorkbook
For Each ws In wb.Worksheets ws.Copy ActiveWorkbook.SaveAs wb.Path & "\" & ws.Name & " " & Format(Now, "yyyy.mm.dd hh-mm-ss") & Right(Format(Timer, "0.000"), 4) & ".xlsx", 51 Next
Целый день папки преобразовываю в сжатые папки , нижеуказанный макрос , делит вкладки на файлы, под каждый файл создает папку, называют эту папку именем файла, а не знаете ли , возможно ли создавать папки сразу сжатые ?
[vba]
Код
Sub Разбивка() ' Макрос создаёт новые книги с содержимом исходной (активной) книги и сохраняет их по названиям листов в изначальной (активной) книге '' Количество новых книг = количеству листов в изначальной (активной) книге и является переменной величиной ''' Изначальная (активная) книга должна быть сохранена хотя бы раз '''' Новые книги сохраняются по тому же пути, где и расположен исходный файл, но с добавлением суффикса - даты и времени сохранения
Application.ScreenUpdating = False
Dim Ws As Worksheet Dim sPath$ Dim sSuff$: sSuff = " ((" & Format(Now, "yyyy.mm.dd hh-mm'ss''") & "))" ' суффикс к имени файла копии - дата и время сохренения копии файла Dim Wb As Workbook Set Wb = ActiveWorkbook
For Each Ws In Wb.Worksheets sPath = Wb.Path & "\" & Ws.Name If Dir$(sPath, vbDirectory) = "" Then MkDir (sPath) Ws.Copy With ActiveWorkbook .SaveAs sPath & "\" & Ws.Name & sSuff & ".xlsx", 51 .Close End With Next Application.ScreenUpdating = True
End Sub
[/vba]
Коллеги, сос
Целый день папки преобразовываю в сжатые папки , нижеуказанный макрос , делит вкладки на файлы, под каждый файл создает папку, называют эту папку именем файла, а не знаете ли , возможно ли создавать папки сразу сжатые ?
[vba]
Код
Sub Разбивка() ' Макрос создаёт новые книги с содержимом исходной (активной) книги и сохраняет их по названиям листов в изначальной (активной) книге '' Количество новых книг = количеству листов в изначальной (активной) книге и является переменной величиной ''' Изначальная (активная) книга должна быть сохранена хотя бы раз '''' Новые книги сохраняются по тому же пути, где и расположен исходный файл, но с добавлением суффикса - даты и времени сохранения
Application.ScreenUpdating = False
Dim Ws As Worksheet Dim sPath$ Dim sSuff$: sSuff = " ((" & Format(Now, "yyyy.mm.dd hh-mm'ss''") & "))" ' суффикс к имени файла копии - дата и время сохренения копии файла Dim Wb As Workbook Set Wb = ActiveWorkbook
For Each Ws In Wb.Worksheets sPath = Wb.Path & "\" & Ws.Name If Dir$(sPath, vbDirectory) = "" Then MkDir (sPath) Ws.Copy With ActiveWorkbook .SaveAs sPath & "\" & Ws.Name & sSuff & ".xlsx", 51 .Close End With Next Application.ScreenUpdating = True
NikitaDvorets, Но как это вставить уже в существующий макрос, чтобы не все папки сжались в одну сжатую папку, а каждая папка которая создавалась, сжималась
[vba]
Код
Sub Разбивка() ' Макрос создаёт новые книги с содержимом исходной (активной) книги и сохраняет их по названиям листов в изначальной (активной) книге '' Количество новых книг = количеству листов в изначальной (активной) книге и является переменной величиной ''' Изначальная (активная) книга должна быть сохранена хотя бы раз '''' Новые книги сохраняются по тому же пути, где и расположен исходный файл, но с добавлением суффикса - даты и времени сохранения
Application.ScreenUpdating = False
Dim Ws As Worksheet Dim sPath$ Dim sSuff$: sSuff = " ((" & Format(Now, "yyyy.mm.dd hh-mm'ss''") & "))" ' суффикс к имени файла копии - дата и время сохренения копии файла Dim Wb As Workbook Set Wb = ActiveWorkbook
For Each Ws In Wb.Worksheets sPath = Wb.Path & "\" & Ws.Name If Dir$(sPath, vbDirectory) = "" Then MkDir (sPath) Ws.Copy With ActiveWorkbook .SaveAs sPath & "\" & Ws.Name & sSuff & ".xlsx", 51 .Close End With Next Application.ScreenUpdating = True
End Sub
[/vba]
NikitaDvorets, Но как это вставить уже в существующий макрос, чтобы не все папки сжались в одну сжатую папку, а каждая папка которая создавалась, сжималась
[vba]
Код
Sub Разбивка() ' Макрос создаёт новые книги с содержимом исходной (активной) книги и сохраняет их по названиям листов в изначальной (активной) книге '' Количество новых книг = количеству листов в изначальной (активной) книге и является переменной величиной ''' Изначальная (активная) книга должна быть сохранена хотя бы раз '''' Новые книги сохраняются по тому же пути, где и расположен исходный файл, но с добавлением суффикса - даты и времени сохранения
Application.ScreenUpdating = False
Dim Ws As Worksheet Dim sPath$ Dim sSuff$: sSuff = " ((" & Format(Now, "yyyy.mm.dd hh-mm'ss''") & "))" ' суффикс к имени файла копии - дата и время сохренения копии файла Dim Wb As Workbook Set Wb = ActiveWorkbook
For Each Ws In Wb.Worksheets sPath = Wb.Path & "\" & Ws.Name If Dir$(sPath, vbDirectory) = "" Then MkDir (sPath) Ws.Copy With ActiveWorkbook .SaveAs sPath & "\" & Ws.Name & sSuff & ".xlsx", 51 .Close End With Next Application.ScreenUpdating = True
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
