Vba excel скопировать лист с новым именем - Word и Excel - помощь в работе с программами

1 / 0 / 2

Регистрация: 09.09.2013

Сообщений: 125

Создать копию листа и переименовать его

25.07.2015, 11:06. Показов 15941. Ответов 1

нужна помощь. у меня есть таблица 10 строк.
столбцы — ФИО, дата рождения, гражданство.
я сделал так, что первая запись переносится на другой лист с названием «Анкета 1».
но мне нужно 10 анкет.
внимание вопрос — как создать копию бланка анкеты (название ее — «бланк анкеты»), а потом переименовать ее.
данные я понимаю как туда засунуть, а вот просто как скопировать и переименовать — нет(((
подскажите.
спасибо.

Казанский

15136 / 6410 / 1730

Регистрация: 24.09.2011

Сообщений: 9,999

25.07.2015, 13:56

Сообщение было отмечено Памирыч как решение

Решение

Сообщение от vitaliypro

а вот просто как скопировать и переименовать — нет

Макрорекордер Вам в помощь, чтобы увидеть, какие методы и свойства используются. А потом «причесать»

Visual Basic

Dim i As Long, n As Long
n = Sheets.Count - 1
For i = 1 To 10
  Sheets("бланк анкеты").Copy after:=Sheets(n + i)
  ActiveSheet.Name = "Анкета " & i
Next

IT_Exp Эксперт 87844 / 49110 / 22898 Регистрация: 17.06.2006 Сообщений: 92,604	25.07.2015, 13:56
2

Источник

Создание, копирование, перемещение и удаление рабочих листов Excel с помощью кода VBA. Методы Sheets.Add, Worksheet.Copy, Worksheet.Move и Worksheet.Delete.

Создание новых листов

Создание новых рабочих листов осуществляется с помощью метода Sheets.Add.

Синтаксис метода Sheets.Add

expression.Add [Before, After, Count, Type]

где expression — переменная, представляющая собой объект Sheet.

Компоненты метода Sheets.Add

Before* — необязательный параметр типа данных Variant, указывающий на лист, перед которым будет добавлен новый.
After* — необязательный параметр типа данных Variant, указывающий на лист, после которого будет добавлен новый.
Count — необязательный параметр типа данных Variant, указывающий, сколько листов будет добавлено (по умолчанию — 1).
Type — необязательный параметр типа данных Variant, указывающий тип листа: xlWorksheet** (рабочий лист) или xlChart (диаграмма), по умолчанию — xlWorksheet.

*Если Before и After не указаны, новый лист, по умолчанию, будет добавлен перед активным листом.

**Для создания рабочего листа (xlWorksheet) можно использовать метод Worksheets.Add, который для создания диаграмм уже не подойдет.

Примеры создания листов

‘Создание рабочего листа:

Sheets.Add

Worksheets.Add

ThisWorkbook.Sheets.Add After:=ActiveSheet, Count:=2

Workbooks(«Книга1.xlsm»).Sheets.Add After:=Лист1

Workbooks(«Книга1.xlsm»).Sheets.Add After:=Worksheets(1)

Workbooks(«Книга1.xlsm»).Sheets.Add After:=Worksheets(«Лист1»)

‘Создание нового листа с заданным именем:

Workbooks(«Книга1.xlsm»).Sheets.Add.Name = «Мой новый лист»

‘Создание диаграммы:

Sheets.Add Type:=xlChart

‘Добавление нового листа перед

‘последним листом рабочей книги

Sheets.Add Before:=Sheets(Sheets.Count)

‘Добавление нового листа в конец

Sheets.Add After:=Sheets(Sheets.Count)

Лист1 в After:=Лист1 — это уникальное имя листа, указанное в проводнике редактора VBA без скобок.
Лист1 в After:=Worksheets(«Лист1») — это имя на ярлыке листа, указанное в проводнике редактора VBA в скобках.

Создаваемый лист можно присвоить объектной переменной:

Dim myList As Object

‘В активной книге

Set myList = Worksheets.Add

‘В книге «Книга1.xlsm»

Set myList = Workbooks(«Книга1.xlsm»).Worksheets.Add

‘Работаем с переменной

myList.Name = «Listok1»

myList.Cells(1, 1) = myList.Name

‘Очищаем переменную

Set myList = Nothing

Если создаваемый лист присваивается объектной переменной, он будет помещен перед активным листом. Указать дополнительные параметры невозможно.

Копирование листов

Копирование рабочих листов осуществляется с помощью метода Worksheet.Copy.

Синтаксис метода Worksheet.Copy

expression.Copy [Before, After]

где expression — переменная, представляющая собой объект Worksheet.

Компоненты метода Worksheet.Copy

Before* — необязательный параметр типа данных Variant, указывающий на лист, перед которым будет добавлена копия.
After* — необязательный параметр типа данных Variant, указывающий на лист, после которого будет добавлена копия.

*Если Before и After не указаны, Excel создаст новую книгу и поместит копию листа в нее. Если скопированный лист содержит код в проекте VBA (в модуле листа), он тоже будет перенесен в новую книгу.

Примеры копирования листов

‘В пределах активной книги

‘(уникальные имена листов)

Лист1.Copy After:=Лист2

‘В пределах активной книги

‘(имена листов на ярлычках)

Worksheets(«Лист1»).Copy Before:=Worksheets(«Лист2»)

‘Вставить копию в конец

Лист1.Copy After:=Sheets(Sheets.Count)

‘Из одной книги в другую

Workbooks(«Книга1.xlsm»).Worksheets(«Лист1»).Copy _

After:=Workbooks(«Книга2.xlsm»).Worksheets(«Лист1»)

‘Один лист активной книги в новую книгу

Лист1.Copy

‘Несколько листов активной книги в новую книгу*

Sheets(Array(«Лист1», «Лист2», «Лист3»)).Copy

‘Все листы книги с кодом в новую книгу

ThisWorkbook.Worksheets.Copy

* Если при копировании в новую книгу нескольких листов хотя бы один лист содержит умную таблицу — копирование невозможно. Один лист, содержащий умную таблицу, копируется в новую книгу без проблем.

Если рабочие книги указаны как элементы коллекции Workbooks, в том числе ActiveWorkbook и ThisWorkbook, листы нужно указывать как элементы коллекции Worksheets, использование уникальных имен вызовет ошибку.

Перемещение листов

Перемещение рабочих листов осуществляется с помощью метода Worksheet.Move.

Синтаксис метода Worksheet.Move

expression.Move [Before, After]

где expression — переменная, представляющая собой объект Worksheet.

Компоненты метода Worksheet.Move

Before* — необязательный параметр типа данных Variant, указывающий на лист, перед которым будет размещен перемещаемый лист.
After* — необязательный параметр типа данных Variant, указывающий на лист, после которого будет размещен перемещаемый лист.

*Если Before и After не указаны, Excel создаст новую книгу и переместит лист в нее.

Примеры перемещения листов

Простые примеры перемещения листов:

‘В пределах активной книги

‘(уникальные имена листов)

Лист1.Move After:=Лист2

‘В пределах активной книги

‘(имена листов на ярлычках)

Worksheets(«Лист1»).Move Before:=Worksheets(«Лист2»)

‘Размещение после последнего листа:

Лист1.Move After:=Sheets(Sheets.Count)

‘Из одной книги в другую

Workbooks(«Книга1.xlsm»).Worksheets(«Лист1»).Move _

After:=Workbooks(«Книга2.xlsm»).Worksheets(«Лист1»)

‘В новую книгу

Лист1.Move

Перемещение листа «Лист4» в позицию перед листом, указанным как по порядковому номеру, так и по имени ярлыка:

Sub Peremeshcheniye()

Dim x

x = InputBox(«Введите имя или номер листа», «Перемещение листа «Лист4»»)

If IsNumeric(x) Then x = CLng(x)

Sheets(«Лист4»).Move Before:=Sheets(x)

End Sub

Удаление листов

Удаление рабочих листов осуществляется с помощью метода Worksheet.Delete

Синтаксис метода Worksheet.Delete

expression.Delete

где expression — переменная, представляющая собой объект Worksheet.

Примеры удаления листов

‘По уникальному имени

Лист1.Delete

‘По имени на ярлычке

Worksheets(«Лист1»).Delete

‘По индексу листа

Worksheets(1).Delete

‘В другой книге

Workbooks(«Книга1.xlsm»).Worksheets(«Лист1»).Delete

Как обратиться к рабочему листу, переименовать, скрыть или отобразить его с помощью кода VBA Excel, смотрите в этой статье.

Источник

В этом примере детально описана и разобрана автоматизация копирования и переименования листов Excel с исходными кодами макросов.

Как копировать и переименовать лист Excel макросом

Представьте ситуацию: Вы готовите планы работ для сотрудников определенного отдела фирмы. Пример таблицы плана выглядит так:

Руководитель этого отдела пожелал, чтобы названия листов планов работ для каждого сотрудника содержали их имена и фамилии.

Многократное копирование листов шаблона для составления и заполнения планов работ сотрудников с переименованием, потребует много времени и сил если делать все это вручную. Поэтому напишем свой макрос, который упростит данную задачу.

Техническое Задание (ТЗ) для макроса заключается в следующем. После выделения ячеек, которые содержат названия для листов нужно скопировать лист с шаблоном для планов работ ровно столько сколько будет выделенных ячеек и ввести соответствующие названия в ярлычки.

Примечание. В программировании, как и в многих других технических сферах деятельности (например, в бизнес-планировании) – без ТЗ результат ХЗ! Автор цитаты известный бизнесмен и предприниматель Дмитрий Потапенко.

Для этого сначала откройте редактор кода макроса: «РАЗРАБОТЧИК»-«Код»-«Visual Basic» (ALT+F11):

В редакторе создайте новый модуль выбрав инструмент «Insert»-«Module» и введите в него следующий код макроса:

Sub PlanRabot() Dim diapaz As Range Dim i As Long Dim list As Worksheet On Error Resume Next Set diapaz = Application.InputBox("Пожалуйста, выделите диапазон ячеек, который содержит названия для новых листов!", Type:=8) On Error GoTo 0 If diapaz Is Nothing Then Exit Sub Set list = ActiveSheet For i = 1 To diapaz.Count list.Copy after:=ActiveSheet ActiveSheet.Name = Left(diapaz(i), 31) Next End Sub

Теперь если вы хотите скопировать лист шаблона для заполнения плана работ и создать копии плана для каждого сотрудника имена с фамилиями которых будут присвоены названиям листа, то перейдите на исходный лист с шаблоном плана работ и выберите инструмент: «РАЗРАБОТЧИК»-«Код»-«Макросы»-«PlanRabot»-«Выполнить». Сразу же после запуска макроса появиться диалоговое окно:

Теперь перейдите на лист «Имена и Фамилии» и выделите в нем диапазон ячеек, которые содержат имена и фамилии сотрудников. И нажмите на кнопку ОК.

В результате чего макрос сам автоматически скопирует планы работ для каждого сотрудника и присвоит новым листам соответственные имена и фамилии.

Описание исходного кода макроса для копирования и переименования листов

В начале кода макроса вызываем диалоговое окно для выделения диапазона ячеек на рабочем листе Excel и присвоения адреса диапазона в качестве значения для поля ввода данного диалогового окна.

Перед вызовом инструкции открытия диалогового окна отключается контроль ошибок. А после создания экземпляра объекта Range в переменной diapaz, снова включается контроль ошибок. Сделано так потому, что нажатие на кнопку «Отмена» в диалоговом окне вызовет ошибку выполнения макроса. Если же отключить обработку ошибок то, когда пользователь нажмет на кнопку «Отмена», тогда просто не будут выполняться никакие инструкции макроса.

В случаи если пользователь заполнил поле ввода и нажал на кнопку «ОК», тогда в переменную list присваиваться текущий рабочий лист. После чего внутри цикла он копируется ровно столько раз, сколько было выделено ячеек.

В процессе копирования каждому новому листу присваивается имя, которое берется из значения текущей ячейки из предварительно выделенного диапазона. Текст в ячейках обрезается до 31 символов, так как максимальная длинна наименования листа не может содержать более чем 31 символ.

Если необходимо сделать так чтобы соответственные имена и фамилии сотрудников были не только на ярлычках листов, а и в значении ячейки B1 в каждом листе, тогда перед строкой конца цикла Next добавьте следующую строку кода:

ActiveSheet.Range(«B1») = diapaz(i)

Подобным способом можно вводить имена и названия для других ячеек листа. Достаточно указать желаемый адрес ячейки в кавычках.

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

Sub PlanRabot() Dim diapaz As Range Dim i As Long Dim list As Worksheet On Error Resume Next Set diapaz = Application.InputBox("Пожалуйста, выделите диапазон ячеек, который содержит названия для новых листов!", Type:=8) On Error GoTo 0 If diapaz Is Nothing Then Exit Sub Set list = ActiveSheet For i = 1 To diapaz.Count list.Copy after:=ActiveSheet ActiveSheet.Name = Left(diapaz(i), 31) ActiveSheet.Range("B1") = diapaz(i) Next End Sub

Пример вставки имен и фамилий не только в ярлычки листов, а и в их определенные пользователем ячейки:

Читайте также: Макрос для копирования листов Excel с заданным количеством копий.

Таким образом, благодаря макросу в пару кликов мышкой можно выполнить большой объем работы. В данном примере скопировано копий только для 8-ми сотрудников. Особенно ощутимую пользу приносит данный макрос при необходимости копировать большое количество листов. Ведь в некоторых фирмах количество сотрудников, заполняющих планы работы, может превышать 100 человек и более.

Источник

Sergey_85

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

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

21.02.2013 13:08:39

Уважаемые форумчане, подскажите пожалуйста в решении такой задачи.

Есть список названий листов в некотором диапазоне ячеек на одном из листов (примерно 200 листов, вручную копировать муторно) о_О.
1) Как размножить лист (образец) с присвоением ему имени из диапазона ячеек с данными.
2) Если лист с таким названием есть, то пропуск копирования.

Нашел подобную тему, но затрудняюсь в некоторых моментах
нужен цикл перебора диапазона ячеек для создания листов
при копировании листа назначать имя из ячейки диапазона имен

Код

Sub qwe()
Dim wsSh As Worksheet
   On Error Resume Next

   For Each wsSh In ThisWorkbook.Sheets
      If wsSh.Name = Sheets("Лист" ;) .[A1] Then
         Msgbox "Есть уже такой"
         Exit Sub
      End if
   Next

   Set wsSh = Sheets("Лист" ;) .[A1]
   Sheets("Лист" ;) .Copy After:=Sheets(Sheets.Count)
   Sheets("Лист (2)" ;) .Name = Sheets("Лист" ;) .[A1]
End Sub

Прикрепленные файлы

Книга1.xlsx (8.4 КБ)

Алексей Семенюк

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

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

21.02.2013 14:50:41

На коленке делал, но вроде работает

Код

Sub CopySheetExample()
    Dim objListCopy As Worksheet
    Dim strLastName As String
    Dim rngName As Range 'диапазон нужных листов
    Dim rgCell As Range ' переменная для перебора коллекции
    
    strLastName = "Образец"
    
    Set rngName = ActiveWorkbook.Sheets("настр").Range("Нужные_листы")
    
    For Each rgCell In rngName
        If ExistList(rgCell.Value) = False Then
            ActiveWorkbook.Sheets("Образец").Copy ActiveWorkbook.Sheets(strLastName)
            Set objListCopy = ActiveWorkbook.Sheets(1)
            objListCopy.Name = rgCell.Value
            strLastName = rgCell.Value
        End If
        
        
    
    Next rgCell

End Sub

Function ExistList(strListName As String) As Boolean

    Dim objWsheet As Worksheet
    
    On Error GoTo Metka:
    Set objWsheet = ActiveWorkbook.Sheets(strListName)
    ExistList = True
Exit Function
Metka:
    ExistList = False
    

End Function

Прикрепленные файлы

Копировать лист.xlsm (17.09 КБ)

Sanja Пользователь Сообщений: 14838 Регистрация: 10.01.2013	Sergey_85 А что вот это: If wsSh.Name = Sheets(«Лист»;).[A1]; Then Согласие есть продукт при полном непротивлении сторон.

Sanja Пользователь Сообщений: 14838 Регистрация: 10.01.2013	Смайлики сами ставятся. .[A1] ? Согласие есть продукт при полном непротивлении сторон.

Алексей Семенюк

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

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

21.02.2013 14:56:43

Для ссылки на диапазон в котором находятся имена листов создал в книге имя «Нужные_листы». Его уже программно превратил в диапазон Range. Единственный вопрос. Не получилось получить сразу ссылку на скопированный лист. Может кто подскажет как. Конструкция вроде

Код
Set x = ActiveWorkbook.Sheets("Образец").Copy ActiveWorkbook.Sheets(strLastName)

Отказалась работать. Ругается — «нужен объект»

Sanja Пользователь Сообщений: 14838 Регистрация: 10.01.2013	Это скобки что-ли? Согласие есть продукт при полном непротивлении сторон.

Юрий Пользователь Сообщений: 212 Регистрация: 27.12.2012	Вот есть наброски, но нужно дорабатывать.

Sergey_85

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

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

Всем огромное спасибо за участие!
Алексей Семенюк
единственное, что копируется еще и образец, но это не проблема удалить
а как ввести проверку на существование листа перед копированием или можно просто пропуск ошибки??

За проверку наличия листа отвечает функция ExistList(). В каком месте кода ее применить — дело хозяйкое. Функция работает исходя из следующих принципов:
1. Если есть лист с именем переданным в парамере strListName, возвращается значение «Верно»
2. Если такого листа нет — VBA генерирует ошибку, при возникновении которой выполнение идет от метки Metka и функция возвращает «Ложь» Т.е. листа нет.
Был у меня другой вариант проверки листа без вызывания ошибок по памяти не вспомню. Вечером выложу.

Юрий М

Модератор

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

Контакты см. в профиле

#10

21.02.2013 16:43:21

Цитата
Sergey_85 пишет: а как ввести проверку на существование листа перед копированием

Посмотрите

здесь

by_lesavik

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

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

#11

21.02.2013 22:54:19

Поиск существующего листа без генерации ошибки.

Код

Function ExistSheet(strSheetName As String) As Boolean
    Dim shWsheet As Worksheet
    
       
    For Each shWsheet In ActiveWorkbook.Worksheets
    
        If shWsheet.Name = strSheetName Then
            ExistSheet = True 'òàêîé ëèñò óæå ñóùåñòâóåò
            Exit Function
        End If
        
    Next
    ExistSheet = False
End Function

Источник

Обычно вы можете применять Переместить или скопировать для копирования рабочего листа, а затем введите новое имя для копии вручную по мере необходимости. Но пробовали ли вы когда-нибудь переименовать лист на основе значения ячейки после копирования рабочего листа? В этой статье я расскажу о том, как автоматически переименовать рабочий лист на основе значения ячейки при создании копии.

Скопируйте рабочий лист и переименуйте на основе значения ячейки с кодом VBA

Скопируйте рабочий лист несколько раз и переименуйте на основе значений ячеек с помощью Kutools for Excel

Скопируйте рабочий лист и переименуйте на основе значения ячейки с кодом VBA

Следующий код VBA может помочь вам скопировать рабочий лист и автоматически переименовать его с определенным значением ячейки, пожалуйста, сделайте следующее:

1. Активируйте рабочий лист, который вы хотите скопировать, а затем удерживайте ALT + F11 , чтобы открыть Microsoft Visual Basic для приложений окно.

2. Нажмите Вставить > Модулии вставьте следующий код в Модули Окно.

Код VBA: скопируйте рабочий лист и переименуйте его, указав значение ячейки:

Sub Copyrenameworksheet()
'Updateby Extendoffice
    Dim ws As Worksheet
    Set wh = Worksheets(ActiveSheet.Name)
    ActiveSheet.Copy After:=Worksheets(Sheets.Count)
    If wh.Range("A1").Value <> "" Then
    ActiveSheet.Name = wh.Range("A1").Value
    End If
    wh.Activate
End Sub

3, Затем нажмите F5 ключ для запуска этого кода, и ваш текущий рабочий лист был скопирован в текущую книгу после всех рабочих листов, и он переименован с указанным вами значением ячейки, см. снимок экрана:

Внимание: В приведенном выше коде ссылка на ячейку A1 — это значение ячейки, которое вы хотите переименовать для нового скопированного листа, вы можете изменить его по своему усмотрению.

Скопируйте рабочий лист несколько раз и переименуйте на основе значений ячеек с помощью Kutools for Excel

Приведенный выше код можно переименовать только с одним значением ячейки, если вам нужно скопировать лист несколько раз и переименовать их на основе списка значений ячеек, Kutools for ExcelАвтора Создать рабочий лист последовательности может помочь вам выполнить эту задачу как можно быстрее.

После установки Kutools for Excel, пожалуйста, сделайте следующее:

1. Нажмите Кутулс Плюс > Рабочий лист > Создать рабочие листы последовательностей, см. снимок экрана:

2. В Создать рабочий лист последовательности диалоговом окне выполните следующие операции:

(1.) Выберите имя рабочего листа, который вы хотите скопировать из Базовый рабочий лист раскрывающийся список;

(2.) Выберите «Данные в диапазоне» под Имена листов на основе раздел и нажмите кнопку, чтобы выбрать значения ячеек, на основе которых вы хотите переименовать скопированные листы.

Скачать Kutools for Excel Сейчас !

3. Затем нажмите Ok кнопку, и конкретный рабочий лист были скопированы несколько раз и переименованы значениями ячеек, которые вы выбрали в новой книге, см. снимок экрана:

Скачать и бесплатную пробную версию Kutools for Excel Сейчас !

Демонстрация: скопируйте рабочий лист несколько раз и переименуйте на основе значений ячеек с помощью Kutools for Excel

Лучшие инструменты для работы в офисе

Kutools for Excel Решит большинство ваших проблем и повысит вашу производительность на 80%

Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма …
Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон…
Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы… Предотвращение дублирования ячеек; Сравнить диапазоны…
Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор …
Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое …
Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии…
Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом …
Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF…
Более 300 мощных функций. Поддерживает Office/Excel 2007-2021 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.

Вкладка Office: интерфейс с вкладками в Office и упрощение работы

Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!

Комментарии (2)

Оценок пока нет. Оцените первым!

Источник

Копировать лист и присвоить имя

Dasdasgret

Дата: Пятница, 12.01.2018, 09:52 |
Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 7

Репутация:
0
±

Замечаний:
0% ±

Excel 2016

Добрый день.
Не получается правильно написать макрос.
Если нужен пример то выложу.

Нужно копировать лист «123» присвоить ему имя «текущая дата» (если такое имя уже есть то «12.11.18 (1)» .. «12.01.18 (2)» и тд.), затем поставить защиту на лист (с паролем «123») на изменение и скрыть.
Макрос должен запускаться при сохранении.

Попробовал собрать ответы из разных тем не получается.
Спасибо всем кто откликнется.

Ответить

Manyasha

Дата: Пятница, 12.01.2018, 10:14 |
Сообщение № 2

Группа: Модераторы

Ранг: Старожил

Сообщений: 2198

Репутация:
898
±

Замечаний:
0% ±

Excel 2010, 2016

Dasdasgret, здравствуйте.
Покажите свои попытки.

ЯД: 410013299366744 WM: R193491431804

Ответить

Manyasha

Дата: Пятница, 12.01.2018, 11:04 |
Сообщение № 3

Группа: Модераторы

Ранг: Старожил

Сообщений: 2198

Репутация:
898
±

Замечаний:
0% ±

Excel 2010, 2016

Dasdasgret, попробуйте так:
[vba]

Код

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim sh As Worksheet, i, shName$
    Sheets(«123»).Copy Before:=Sheets(1)
    On Error Resume Next
    Set sh = Sheets(CStr(Date))
    If sh Is Nothing Then
        shName = Date
    Else
        Do While (Not sh Is Nothing)
            i = i + 1
            Set sh = Nothing
            Set sh = Sheets(Date & » (» & i & «)»)
        Loop
        shName = Date & » (» & i & «)»
    End If
    On Error GoTo 0
    With ActiveSheet
        .Name = shName
        .Protect Password:=»123″
        .Visible = xlSheetVeryHidden ‘ или просто xlSheetHidden
    End With
End Sub

[/vba]

ЯД: 410013299366744 WM: R193491431804

Сообщение отредактировал Manyasha — Пятница, 12.01.2018, 17:37

Ответить

Mikael

Дата: Пятница, 12.01.2018, 11:40 |
Сообщение № 4

Группа: Пользователи

Ранг: Участник

Сообщений: 80

Репутация:
31
±

Замечаний:
0% ±

Excel 2010

Здравствуйте!
Manyasha, прям почти один в один specool
Мой вариант:
[vba]

Код

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Application.ScreenUpdating = 0

Dim wsSh As Worksheet

On Error Resume Next: Set wsSh = Sheets(CStr(Date)): On Error GoTo 0

‘Копирование листа
Sheets(«123»).Copy After:=Sheets(Sheets.Count)

With ActiveSheet

‘Если есть лист с текущей датой
If Not wsSh Is Nothing Then

Dim iCntr As Integer

On Error Resume Next

Do
iCntr = iCntr + 1

Set wsSh = Nothing
Set wsSh = Sheets(CStr(Date) & » (» & iCntr & «)»)

Loop While Not wsSh Is Nothing

On Error GoTo 0

.Name = Date & » (» & iCntr & «)»

Else ‘ если нет

.Name = Date

End If ‘Not wsSh Is Nothing

                ‘Невидимый
        .Visible = xlSheetHidden
        ‘Защищен с паролем
        .Protect Password:=»123″

End With ‘ActiveSheet

Application.ScreenUpdating = 1

End Sub

[/vba]

Сообщение отредактировал Mikael — Пятница, 12.01.2018, 11:42

Ответить

Dasdasgret

Дата: Пятница, 12.01.2018, 13:53 |
Сообщение № 5

Группа: Пользователи

Ранг: Прохожий

Сообщений: 7

Репутация:
0
±

Замечаний:
0% ±

Excel 2016

Manyasha, Спасибо! все работает

мое такое было, 2 листа сохранял, потом ошибка была. может напоследок скажете почему там только до 2х доходит?

[vba]

Код

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Application.ScreenUpdating = 0
Dim i As Integer
i = 0
Sheets(«123»).Copy After:=Sheets(1)
ActiveSheet.Name = «RRTRR»
Sheets(«RRTRR»).Protect Password:=ThisWorkbook.Sheets(«PW»).Range(«A1»)
Sheets(«RRTRR»).Visible = False

ssff:
i = i + 1
On Error GoTo ssff
Sheets(«RRTRR»).Name = Date & «(» & (i) & «)»

Application.ScreenUpdating = 1

End Sub

[/vba]

Сообщение отредактировал Dasdasgret — Пятница, 12.01.2018, 14:24

Ответить

Dasdasgret

Дата: Пятница, 12.01.2018, 14:15 |
Сообщение № 6

Группа: Пользователи

Ранг: Прохожий

Сообщений: 7

Репутация:
0
±

Замечаний:
0% ±

Excel 2016

Еще кто знает можно ли поставить пароль что бы нельзя было изменить xlSheetVeryHidden?

Сообщение отредактировал Dasdasgret — Пятница, 12.01.2018, 14:20

Ответить

Pelena

Дата: Пятница, 12.01.2018, 14:17 |
Сообщение № 7

Группа: Админы

Ранг: Местный житель

Сообщений: 18797

Репутация:
4284
±

Замечаний:
±

Excel 2016 & Mac Excel

Dasdasgret, оформите код тегами с помощью кнопки # в режиме правки поста

«Черт возьми, Холмс! Но как??!!»
Ю-money 41001765434816

Ответить

Mikael

Дата: Пятница, 12.01.2018, 14:32 |
Сообщение № 8

Группа: Пользователи

Ранг: Участник

Сообщений: 80

Репутация:
31
±

Замечаний:
0% ±

Excel 2010

Еще кто знает можно ли поставить пароль что бы нельзя было изменить xlSheetVeryHidden?

Можно поставить пароль на проект. В редакторе VB ПКМ по проекту (VBAProject(…)) -> Properties -> закладка Protection

Ответить

Mikael

Дата: Пятница, 12.01.2018, 14:52 |
Сообщение № 9

Группа: Пользователи

Ранг: Участник

Сообщений: 80

Репутация:
31
±

Замечаний:
0% ±

Excel 2010

Слушайте, не пойму, в чем практический смысл в данном случае использовать событие _AfterSave?
Ведь получается, что макрос после сохранения вносит изменения в книгу, что приводит параметр книги Saved в положение False, т.е. после сохранения, книга все равно будет не сохранена, а попытка закрыть книгу приведет к диалоговому окну «сохранить перед выходом?»… пользователь может нажать нет и лист, который только что сделался после сохранения в итоге не сохранится, а если нажмет да, это снова вызовет событие _AfterSave. Понимаете мысль?

Сообщение отредактировал Mikael — Пятница, 12.01.2018, 14:55

Ответить

Dasdasgret

Дата: Пятница, 12.01.2018, 15:26 |
Сообщение № 10

Группа: Пользователи

Ранг: Прохожий

Сообщений: 7

Репутация:
0
±

Замечаний:
0% ±

Excel 2016

Mikael, я не знал разницу между AfterSave и BeforeSave, что первое увидел то и поставил.
Сейчас знаю, нужно BeforeSave, а так я не очень понял что Вы написали.
AfterSave выполняется когда сохранишь только через ctrl+S
BeforeSave при ctrl+S и закрытии файла.

Ответить

Mikael

Дата: Пятница, 12.01.2018, 15:54 |
Сообщение № 11

Группа: Пользователи

Ранг: Участник

Сообщений: 80

Репутация:
31
±

Замечаний:
0% ±

Excel 2010

Dasdasgret, обработчики событий очень классная и мощная штука, но их нужно правильно использовать. Все зависит от Ваших конкретных целей, вот я и задался вопросом «в чем смысл».

AfterSave выполняется когда сохранишь только через ctrl+S

Это легко проверить через пошаговый отладчик, при закрытии с сохранением событие тоже срабатывает, но этот новый лист не сохранится в книге.

а так я не очень понял что Вы написали.

Представим, что у Вас новая книга, чистая и еще совсем свежая Вы (или не Вы) там что-то делаете, когда все сделали — сохраняетесь (в это время макрос после сохранения создает скрытый лист), и жмете «крестик» чтобы выйти. Т.к. скрытый лист создавался после сохранения, Excel у Вас спросит «сохранить изменения перед выходом?». Если Вы нажмете «нет» (Вы же только что сохранились перед выходом, зачем еще раз сохраняться, логично?), книга закроется, а когда Вы ее откроете — там не будет этого скрытого листа.

Заранее прошу прощения, если загрузил, это я с добрыми намерениями и из чистых побуждений. victory

Ответить

Dasdasgret

Дата: Пятница, 12.01.2018, 16:15 |
Сообщение № 12

Группа: Пользователи

Ранг: Прохожий

Сообщений: 7

Репутация:
0
±

Замечаний:
0% ±

Excel 2016

Mikael, смысл был в том что мне не важен лист, если тот кто правил файл не захотел в итоге все сохранить.

Ответить

Dasdasgret

Дата: Пятница, 12.01.2018, 16:24 |
Сообщение № 13

Группа: Пользователи

Ранг: Прохожий

Сообщений: 7

Репутация:
0
±

Замечаний:
0% ±

Excel 2016

Повторюсь… Может кто подскажет, где ошибка? Почему только 2 листа делает.. i только до 2х доходит..

[vba]

Код

ssff:
i = i + 1
On Error GoTo ssff
Sheets(«RRTRR»).Name = Date & «(» & (i) & «)»

Application.ScreenUpdating = 1

End Sub

[/vba]

Ответить

Manyasha

Дата: Пятница, 12.01.2018, 17:36 |
Сообщение № 14

Группа: Модераторы

Ранг: Старожил

Сообщений: 2198

Репутация:
898
±

Замечаний:
0% ±

Excel 2010, 2016

в чем практический смысл в данном случае использовать событие _AfterSave?

А я книгу не закрывала во время тестирования, вот и не додумалась))
Конечно лучше на Workbook_BeforeSave исправить (в своем посте исправила).

Может кто подскажет, где ошибка?

Вот в этой теме есть хорошее объяснение.
Вот так работает:
[vba]

Код

ssff:
i = i + 1
On Error GoTo ssff
Resume lab
lab:
Sheets(«RRTRR»).Name = Date & «(» & (i) & «)»

[/vba]

А вообще, On Error GoTo лучше не злоупотреблять.

ЯД: 410013299366744 WM: R193491431804

Ответить

Dasdasgret

Дата: Суббота, 13.01.2018, 01:35 |
Сообщение № 15

Группа: Пользователи

Ранг: Прохожий

Сообщений: 7

Репутация:
0
±

Замечаний:
0% ±

Excel 2016

Тема закрыта. Всем спасибо!

Ответить

Источник

Содержание

Копировать лист в новую книгу
Копировать несколько листов в новую книгу
Копировать лист в той же книге
Переместить лист
Копия и имя листа
Копировать лист в другую книгу
Копировать лист в закрытую книгу
Копировать лист из другой книги, не открывая ее
Дублируйте лист Excel несколько раз

В этом руководстве будет рассказано, как скопировать лист или рабочий лист с помощью VBA.

Копировать лист в новую книгу

Чтобы скопировать лист в новую книгу:

1	Листы («Лист1»). Копировать

Копировать ActiveSheet в новую книгу

Чтобы скопировать ActiveSheet в новую книгу:

Копировать несколько листов в новую книгу

Чтобы скопировать несколько листов в новую книгу:

1	ActiveWindow.SelectedSheets.Copy

Копировать лист в той же книге

Мы начали с того, что показали вам самый простой пример копирования листов: копирование листов в новую рабочую книгу. Эти примеры ниже покажут вам, как скопировать лист в той же книге. При копировании листа в Worbook вы должны указать местоположение. Чтобы указать местоположение, вы скажете VBA переместить рабочий лист ДО или ПОСЛЕ другого рабочего листа.

Копировать лист перед другим листом

Здесь мы укажем копировать и вставлять Sheet перед Sheet2

1	Листы («Лист1»). Копировать до: = Листы («Лист2»)

Копировать лист перед первым листом

Вместо указания имени листа вы также можете указать положение листа. Здесь мы копируем и вставляем лист перед первым листом в книге.

1	Листы («Лист1»). Копировать до: = Листы (1)

Вновь созданный лист теперь будет первым листом в книге.

Копировать лист после последнего листа

Используйте свойство After, чтобы указать VBA вставить лист ПОСЛЕ другого листа. Здесь мы скопируем и вставим лист после последнего листа в книге:

1	Листы («Sheet1»). Копировать после: = Sheets (Sheets.Count)

Обратите внимание, что мы использовали Sheets.Count для подсчета количества листов в книге.

Переместить лист

Вы также можете перемещать лист в рабочей книге, используя аналогичный синтаксис. Этот код переместит Sheet1 в конец рабочей книги:

1	Листы («Sheet1»). Переместить после: = Sheets (Sheets.Count)

Копия и имя листа

После копирования и вставки листа вновь созданный лист становится ActiveSheet. Итак, чтобы переименовать наш новый лист, просто используйте ActiveSheet.Name:

123456

Sub CopySheetRename1 ()Листы («Sheet1»). Копировать после: = Sheets (Sheets.Count)ActiveSheet.Name = «LastSheet»Конец подписки

Если имя листа уже существует, приведенный выше код вызовет ошибку. Вместо этого мы можем использовать «On Error Resume Next», чтобы указать VBA игнорировать именование листа и продолжить остальную часть процедуры:

12345678

Sub CopySheetRename2 ()Листы («Sheet1»). Копировать после: = Sheets (Sheets.Count)При ошибке Возобновить ДалееActiveSheet.Name = «LastSheet»При ошибке GoTo 0Конец подписки

Или используйте нашу функцию RangeExists, чтобы проверить, существует ли уже имя листа, прежде чем пытаться скопировать лист:

123456789101112131415161718

Sub CopySheetRename3 ()Если RangeExists («LastSheet»), тоMsgBox «Лист уже существует».ЕщеЛисты («Sheet1»). Копировать после: = Sheets (Sheets.Count)ActiveSheet.Name = «LastSheet»Конец, еслиКонец подпискиФункция RangeExists (WhatSheet как строка, необязательно ByVal WhatRange As String = «A1») как логическоеТусклый тест как диапазонПри ошибке Возобновить ДалееУстановите test = ActiveWorkbook.Sheets (WhatSheet) .Range (WhatRange)RangeExists = Номер ошибки = 0При ошибке GoTo 0Конечная функция

Копирование и имя листа на основе значения ячейки

Вы также можете скопировать и назвать лист на основе значения ячейки. Этот код будет называть рабочий лист на основе значения ячейки в A1.

12345678

Sub CopySheetRenameFromCell ()Листы («Sheet1»). Копировать после: = Sheets (Sheets.Count)При ошибке Возобновить ДалееActiveSheet.Name = Диапазон («A1»). ЗначениеПри ошибке GoTo 0Конец подписки

Копировать лист в другую книгу

До сих пор мы работали с копированием таблиц в рабочую тетрадь. Теперь мы рассмотрим примеры копирования и вставки листов в другие рабочие книги. Этот код скопирует лист в начало другой книги:

1	Таблицы («Sheet1»). Копировать перед: = Workbooks («Example.xlsm»). Sheets (1)

Это скопирует рабочий лист в конец другой книги.

1	Таблицы («Sheet1»). Копировать после: = Workbooks («Example.xlsm»). Sheets (Workbooks («Example.xlsm»). Sheets.Count)

Обратите внимание, мы заменили 1 с участием Рабочие книги («Example.xlsm»). Sheets.Count чтобы получить последний рабочий лист.

Копировать лист в закрытую книгу

Вы также можете скопировать рабочий лист в закрытую рабочую книгу. Этот код откроет закрытую рабочую книгу, чтобы вы могли скопировать в нее лист.

123456789

Sub CopySheetToClosedWB ()Application.ScreenUpdating = FalseУстановите closedBook = Workbooks.Open («D: Dropbox excel article example.xlsm»)Таблицы («Sheet1»). Копировать до: = closedBook.Sheets (1)closedBook.Close SaveChanges: = TrueApplication.ScreenUpdating = TrueКонец подписки

Копировать лист из другой книги, не открывая ее

И наоборот, этот код скопирует рабочий лист ИЗ закрытой книги без необходимости вручную открывать книгу.

123456789

Sub CopySheetFromClosedWB ()Application.ScreenUpdating = FalseУстановите closedBook = Workbooks.Open («D: Dropbox excel article example.xlsm»)closedBook.Sheets («Sheet1»). Копировать перед: = ThisWorkbook.Sheets (1)closedBook.Close SaveChanges: = FalseApplication.ScreenUpdating = TrueКонец подписки

Обратите внимание, что в обоих этих примерах мы отключили ScreenUpdating, чтобы процесс работал в фоновом режиме.

Дублируйте лист Excel несколько раз

Вы также можете дублировать лист Excel несколько раз, используя цикл.

1234567891011121314

Sub CopySheetMultipleTimes ()Dim n как целое числоDim i как целое числоПри ошибке Возобновить Далееn = InputBox («Сколько копий вы хотите сделать?»)Если n> 0, тоДля i = 1 К nActiveSheet.Copy После: = ActiveWorkbook.Sheets (Worksheets.Count)СледующийКонец, еслиКонец подписки

Вы поможете развитию сайта, поделившись страницей с друзьями

Источник