Страницы: 1
RSS
Дублирование листов в одной книге
 
Допустим, есть файл, в котором имеются 3 листа, в каждом из них находится разная информация и названия листов могут быть разными. Необходим макрос, который создаст копию каждого листа и оставит эти дубликаты в этой же книге.
 
Выделить листы (сгруппировать), нажать ПКМ, выбрать скопировать - чем не вариант?!. ;)
"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
Код
i = 1
For Each sh In ThisWorkbook.Worksheets
     sh.Copy before:=ThisWorkbook.Sheets(i)
i = i + 1
Next
Изменено: ProFessor - 17.04.2018 14:39:49
Вся проблема сложных программ, целых томов кодов и состоит в несоблюдении принципа лезвия Оккама: «Не следует множить сущее без необходимости». Вся гениальность в простоте.
 
Выдернул из надстройки PP UTilities
Код
'---------------------------------------------------------------------------------------
' Procedure : Sheet_Duplicate
' Author    : bdarbonneau
' Date      : 06/02/2015
' Purpose   : Duplicate the selected worksheets
'---------------------------------------------------------------------------------------
'
Sub SheetDuplicate()
    Dim sh As Worksheet
     If ActiveWorkbook.ProtectStructure = True Then
        Exit Sub
    End If

    Application.ScreenUpdating = False
    For Each sh In ActiveWorkbook.Windows(1).SelectedSheets
        sh.Copy After:=sh
    Next
    Application.ScreenUpdating = True

End Sub
 
ProFessor, как сделать, чтобы на каждом листе стоял автофильтр в верхней строке? я имею ввиду, как изобразить это в макросе, не подскажете?
 
Цитата
sdens2009 написал:
ProFessor , как сделать, чтобы на каждом листе стоял автофильтр в верхней строке? я имею ввиду, как изобразить это в макросе, не подскажете?

Вот версия с автофильтром по первой строке скопированных листов:

Код
i = 1
For Each sh In ThisWorkbook.Worksheets
     sh.Copy before:=ThisWorkbook.Sheets(i)
     ActiveWorkbook.ActiveSheet.Rows(1).Select
     Selection.AutoFilter
i = i + 1
Next
Вся проблема сложных программ, целых томов кодов и состоит в несоблюдении принципа лезвия Оккама: «Не следует множить сущее без необходимости». Вся гениальность в простоте.
 
ProFessor, не работает=( копирует только один лист и дальше выбивает ошибку
 
Цитата
sdens2009 написал:
Допустим, есть файл
Ну, допустим...
Попробуем погадать:
sdens2009, а Вы случайно не чистые листы копируете? В верхней строке что-нибудь где-нибудь написано?
Не верю я Вам, у меня макрос из #6 очень даже работает.
Могу поменять свой файл (где работает) на Ваш (где не работает)   :)  
 
Цитата
_Igor_61 написал:
Могу поменять свой файл (где работает) на Ваш (где не работает)    
_Igor_61,  с доплатой :D ?
Если в мире всё бессмысленно, — сказала Алиса, — что мешает выдумать какой-нибудь смысл? ©Льюис Кэрролл
 
Не, просто у меня на сегодня чистых штук пять осталось, жалко раздавать  :)  
 
Цитата
sdens2009 написал:
ProFessor , не работает=( копирует только один лист и дальше выбивает ошибку

Ошибку выбивает, т.к. необходимо читать внимательнее

Цитата
ProFessor написал:
Вот версия с автофильтром по первой строке скопированных листов:

Если Ваша шапка будет располагаться не в первой строке, то будут ошибка
Хотите конкретики - приложите пример
Вся проблема сложных программ, целых томов кодов и состоит в несоблюдении принципа лезвия Оккама: «Не следует множить сущее без необходимости». Вся гениальность в простоте.
 
Цитата
_Igor_61 написал:
Ну, допустим...Попробуем погадать: sdens2009 , а Вы случайно не чистые листы копируете? В верхней строке что-нибудь где-нибудь написано?Не верю я Вам, у меня макрос из #6 очень даже работает.Могу поменять свой файл (где работает) на Ваш (где не работает)    

_Igor_61, 100% прав.
Вся проблема сложных программ, целых томов кодов и состоит в несоблюдении принципа лезвия Оккама: «Не следует множить сущее без необходимости». Вся гениальность в простоте.
 
_Igor_61, ProFessor, тут я был не прав, извиняюсь. но автофильтр добавляется только на дубликаты, а необходимо на все листы
 
Тогда ставьте фильтр на исходных листах, а потом копируйте
 
а можно это как то сделать с помощью макроса? в начале поставить фильтр на всех листах, потом скопировать листы, и чтобы на дубликатах тоже был автофильтр.
 
Код
i = 1
For Each sh In ThisWorkbook.Worksheets
     sh.Copy before:=ThisWorkbook.Sheets(i)
i = i + 1
Next

For Each sh In ThisWorkbook.Worksheets
     sh.Activate
     ActiveWorkbook.ActiveSheet.Rows(1).Select
     Selection.AutoFilter
Next
Изменено: ProFessor - 18.04.2018 12:20:24 (Оптимизация)
Вся проблема сложных программ, целых томов кодов и состоит в несоблюдении принципа лезвия Оккама: «Не следует множить сущее без необходимости». Вся гениальность в простоте.
 
Цитата
ProFessor написал:
приложите пример
Цитата
_Igor_61 написал:
Могу поменять свой файл (где работает) на Ваш (где не работает)
+ Правила форума, п.2.3
Ну я не знаю, как еще убеждать...

И вообще непонятен смысл такого макроса. Способ из #2 не годится? Почему?
Неужели проще и быстрее сначала сохранить файл в xlsm, потом открыть VBA редактор, потом создать модуль, вставить в него макрос, затем этот макрос запустить... ???  
 
Как вариант:
Код
Sub test()
    Dim sht As Worksheet
    For Each sht In Worksheets
        If sht.AutoFilterMode = False And sht.UsedRange.Count > 1 Then sht.Rows(1).AutoFilter
        sht.Copy after:=Worksheets(Sheets.Count)
    Next sht
End Sub
"Все гениальное просто, а все простое гениально!!!"
 
Спасибо большое за помощь. И тот и другой коды подошли!
Страницы: 1
Наверх