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

Создание, копирование, перемещение и удаление рабочих листов 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, который для создания диаграмм уже не подойдет.

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

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

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

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

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

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

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

Лист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

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

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

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

Лист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

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

Перемещение листа «Лист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

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

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

 

Уважаемые форумчане! Честно искала в форуме, находила, но не смогла переделать найденный код под свои нужды. Проблема такая: в книге много скрытых листов, надо сохранить в новую книгу несколько листов таким образом, чтобы копировались только значения ячеек и элементов управления на листе и пользователь мог только смотреть и распечатывать содержимое (словно картинкой листы копировались).  
Нашла в инете код для одного листа, но при копировании часть текста теряется, плюс не знаю, как вставить в процедуру еще несколько листов:  
Sub SaveSheet()  
Dim ActiveSht As Worksheet  
Dim NewWb As Workbook  
   Set ActiveSht = ActiveSheet  
   Set NewWb = Workbooks.Add  
   ActiveSht.Copy Before:=Workbooks(NewWb.Name).Sheets(1)  
   With ActiveSheet.UsedRange  
       .Value = .Value  
   End With  
   ActiveWorkbook.SaveAs Filename:=»C:» & ActiveSht.Name  
   MsgBox «Лист скопирован в новую книгу и сохранён!», , «»  
End Sub  

  Помогите, пожалуйста!

 

KuklP

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

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

E-mail и реквизиты в профиле.

Чтобы текст не терялся: вместо UsedRange попробуйте Cells  
А чтобы несколько листов, обращайтесь к ним по имени, или по номеру и копируйте по очереди. Можно макрорекордером: выделить несколько листов и скопировать в новую книгу.

Я сам — дурнее всякого примера! …

 

{quote}{login=KuklP}{date=30.03.2010 06:05}{thema=}{post}Чтобы текст не терялся: вместо UsedRange попробуйте Cells  
А чтобы несколько листов, обращайтесь к ним по имени, или по номеру и копируйте по очереди. Можно макрорекордером: выделить несколько листов и скопировать в новую книгу.{/post}{/quote}  

  Замена UsedRange на Cells безнадежно вешает компьютер :(

 

ytk5kyky

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

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

Sub SaveSheet()  
Dim ActiveSht As Worksheet  
Dim NewWb As Workbook  
Sheets(Array(«Лист1», «Лист2», «Лист3»)).Copy ‘ Здесь указываете имена нужных листов, в т.ч. и скрытых.  
Set NewWb = ActiveWorkbook  
For Each ActiveSht In NewWb.Worksheets  
 ActiveSht.Visible = True ‘ делаем скрытые листы видимыми в новой книге.  
 With ActiveSht.UsedRange  
   .Value = .Value  
 End With  
Next  
NewWb.SaveAs Filename:=»C:» & «Лист3.xls» ‘ листов стало много — какое имя нужно давать для книги не знаю.  
End Sub  

  Про текст:  
нужен пример как именно потерялся текст.  
созханите одил лист руками (без потери текста) и один лист макросом. Прикрепите сюда (не забывая про правила формума).

 

{quote}{login=Лузер™}{date=31.03.2010 10:04}{thema=}{post}Sub SaveSheet()  
Dim ActiveSht As Worksheet  
Dim NewWb As Workbook  
Sheets(Array(«Лист1», «Лист2», «Лист3»)).Copy ‘ Здесь указываете имена нужных листов, в т.ч. и скрытых.  
Set NewWb = ActiveWorkbook  
For Each ActiveSht In NewWb.Worksheets  
 ActiveSht.Visible = True ‘ делаем скрытые листы видимыми в новой книге.  
 With ActiveSht.UsedRange  
   .Value = .Value  
 End With  
Next  
NewWb.SaveAs Filename:=»C:» & «Лист3.xls» ‘ листов стало много — какое имя нужно давать для книги не знаю.  
End Sub  

  Про текст:  
нужен пример как именно потерялся текст.  
созханите одил лист руками (без потери текста) и один лист макросом. Прикрепите сюда (не забывая про правила формума).{/post}{/quote}  
Копирование не удается. Выскакивает ошибка (см. вложение) в строке  
«Sheets(Array(«З_СМБ», «П_СМБ», «П_СМБ»)).Copy ‘ Здесь указываете имена нужных листов, в т.ч. и скрытых.»

 

ytk5kyky

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

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

Так вот Вам и ответ почему текст обрезается.  
счас поправим :)

 

{quote}{login=Лузер™}{date=31.03.2010 11:23}{thema=}{post}Так вот Вам и ответ почему текст обрезается.  
счас поправим :){/post}{/quote}  

  Текст, который обрезался, вырезала из ячеек и вставила в textbox`ы. Теперь при выполнении макроса копирования появляется ошибка  
» `1004` Метод Copy из класса Sheets завершен неверно»  
все в той же строке  
«Sheets(Array(«Заявление_СМБ», «Полис_СМБ», «Перечень_СМБ»)).Copy ‘ Здесь указываете имена нужных листов, в т.ч. и скрытых.»

 

ytk5kyky

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

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

Боюсь, без примера все же не обойтись.

 

{quote}{login=Лузер™}{date=31.03.2010 12:58}{thema=}{post}Боюсь, без примера все же не обойтись.{/post}{/quote}  

  Похоже, что проблемы с копированием возникают из-за защищенности книги.  
Тем не менее, копирование не работает так, как хотелось бы. Во вложении пример с Вашим кодом.  
А хотелось бы, чтоб по нажатию кнопки «Скопировать листы» происходило копирование только указанных листов — они скрыты в исходном файле, но должны быть видимыми в новой книге.

 

Уважаемые форумчане! Подскажите, пожалуйста, как решить описанную в теме ситуацию!!

 

KuklP

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

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

E-mail и реквизиты в профиле.

Переименуйте макрос Copy в Copy1 соответственно и ссылку на него в кнопке.

Я сам — дурнее всякого примера! …

 

KuklP

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

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

E-mail и реквизиты в профиле.

Сначала делайте все листы видимыми в исходной книге. Копируете нужные в новую книгу, а исходную закрываете не сохраняя.

Я сам — дурнее всякого примера! …

 

ytk5kyky

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

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

Sub Copy1()  ‘ не используйте зарезервированные имена. Придумайте свое имя макроса.  
Dim ActiveSht As Worksheet  
Dim NewWb As Workbook  
Set NewWb = Workbooks.Add  
For Each ActiveSht In ThisWorkbook.Sheets(Array(«Лист11», «Лист21», «Лист31»))  ‘ не используйте стандартные имена листов или будет ошибка.  
 NewWb.Worksheets.Add.Name = ActiveSht.Name  
 With ActiveSht.UsedRange  
   .Copy  
   ActiveSheet.Range(.Address).PasteSpecial Paste:=xlPasteValues  
   ActiveSheet.Range(.Address).PasteSpecial Paste:=xlPasteFormats  
   ActiveSheet.Range(.Address).PasteSpecial Paste:=xlPasteColumnWidths  
 End With  
Next  
NewWb.SaveAs Filename:=»C:» & «Копия.xls»  ‘ листов стало много — какое имя нужно давать для книги не знаю.  
MsgBox «Формы документов перенесены в новую книгу и сохранены.», , «»  
End Sub

 

KuklP

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

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

E-mail и реквизиты в профиле.

Ув. Лузер™, вот на этой строке:  
For Each ActiveSht In ThisWorkbook.Sheets(Array(«Лист11», «Лист21», «Лист31»))    
Вылетает в Дебаг — Subscript out of range. Мой вариант работает:  
Sub Copy1()  
Dim ActiveSht As Worksheet  
Dim NewWb As Workbook  
For Each ActiveSht In ThisWorkbook.Worksheets  
ActiveSht.Visible = True ‘ делаем скрытые листы видимыми в исходной книге.  
Next  

  Sheets(Array(«Лист1», «Лист2», «Лист3»)).Copy ‘ Здесь указываете имена нужных листов  
Set NewWb = ActiveWorkbook  
For Each ActiveSht In NewWb.Worksheets  
With ActiveSht.UsedRange  
.Value = .Value  
End With  
Next  
NewWb.SaveAs Filename:=»C:» & «Копия.xls» ‘ листов стало много — какое имя нужно давать для книги не знаю.  
MsgBox «Формы документов перенесены в новую книгу и сохранены.», , «»  
ThisWorkbook.Close SaveChanges:=False  
End Sub

Я сам — дурнее всякого примера! …

 

ytk5kyky

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

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

{quote}{login=KuklP}{date=01.04.2010 05:42}{thema=}{post}Ув. Лузер™, вот на этой строке:  
For Each ActiveSht In ThisWorkbook.Sheets(Array(«Лист11», «Лист21», «Лист31»))    
Вылетает в Дебаг — Subscript out of range. Мой вариант работает:  
{/post}{/quote}А листы с такими именами есть? Или так и остались «Лист1», «Лист2», «Лист3»?  
Потом, я не претендую на эксклюзив и работоспособность Вашего варианта не оспариваю.    
Только копирует ли он ячейки с >255 символами? — У топикстартера проблема не только со скрытыми листами. Но и с потерей части текста.  
А нужно ли закрывать исходную книгу? А вдруг в ней остались несохраненые изменения?

 

KuklP

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

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

E-mail и реквизиты в профиле.

{quote}{login=Лузер™}{date=01.04.2010 05:54}{thema=Re: }{post}{quote}{login=KuklP}{date=01.04.2010 05:42}{thema=}{post}Ув. Лузер™, вот на этой строке:  
For Each ActiveSht In ThisWorkbook.Sheets(Array(«Лист11», «Лист21», «Лист31»))    
Вылетает в Дебаг — Subscript out of range. Мой вариант работает:  
{/post}{/quote}А листы с такими именами есть? Или так и остались «Лист1», «Лист2», «Лист3»?  
Потом, я не претендую на эксклюзив и работоспособность Вашего варианта не оспариваю.    
Только копирует ли он ячейки с >255 символами? — У топикстартера проблема не только со скрытыми листами. Но и с потерей части текста.  
А нужно ли закрывать исходную книгу? А вдруг в ней остались несохраненые изменения?{/post}{/quote}  
Копировать можно и по вашему(при этом две строки, формат и ширина отпадают) в новой книге. А сохранение данных — проблема топикстартера. Хотя можно и программно. Одна строка: ActiveWorkbook.Save  
После Dimов. И я вообще-то не об оспаривании писал. Программы Вы пишете блестяще! Просто Черная Дыра(или я неправильно перевел Black__Hole?) нуждается в более… Нет, не так. Не стоит ее перенапрягать. Спасибо, хоть пример выложила. Если бы сделала это 29 числа — давно бы проблема ушла. Но вот прикол — мы тут стараемся, перед работой, после, а она только изредка заглядывает. Может так ей нужно?

Я сам — дурнее всякого примера! …

 

ytk5kyky

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

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

Я понимаю, что сохранить легко. Но если не нужно сохранять? Или наоборот нужно — мы не знаем. Лишнее сохранение/закрытие накладывает ненужные ограничения на функциональность кода.  

  Про «при этом две строки, формат и ширина отпадают» не понял.  

  Про топикстартера — может она чаще не может. Я вот последнее время раз в пять меньше на форуме провожу.

 

KuklP

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

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

E-mail и реквизиты в профиле.

{quote}{login=Лузер™}{date=01.04.2010 10:05}{thema=}{post}  
Про «при этом две строки, формат и ширина отпадают» не понял.  
{/post}{/quote}  
Если скопированы листы целиком то на них уже и формат и ширина, высота, возможно объединенные ячейки и Бог знает что еще — все уже есть. Остается только формулы и ссылки преобразовать в значения. Поэтому мне больше нравится вариант с копированием листов целиком.

Я сам — дурнее всякого примера! …

 

Уважаемые KuklP и Лузер™! Спасибо Вам за то, что оказываете посильную помощь — я искренне Вам признательна!  
KuklP, Вы правы: я профан в vba, тем более, в сравнении с корифеями форума. Ну а незнание синтаксиса порой приводит к возникновению сложностей даже в решении незначительных задач. Однако с помощью этого форума vba перестал быть загадкой и, я надеюсь, достаточно скоро станет полноценным инструментом в руках даже Черной__Дыры.  
Ответы на данную тему приходили не так скоро, как хотелось бы и я пыталась найти иные варианты решения (и на других форумах в том числе). В итоге пришла к такому решению (здесь выложен истинный, а не адаптированный для выкладки примера код):  

  Sub SaveSheet_SMB()  
ThisWorkbook.Unprotect («XXX»)  
   Dim wsSh As Worksheet  
   Dim NewWb As Workbook, asArr(), li As Long  
   Application.ScreenUpdating = False  
   For Each wsSh In Sheets(Array(«П_СМБ», «З_СМБ», «Пер_СМБ»))  
       If wsSh.Visible <> -1 Then ReDim Preserve asArr(li): asArr(li) = wsSh.Name: li = li + 1: wsSh.Visible = xlSheetVisible  
   Next wsSh  
   Sheets(Array(«П_СМБ», «З_СМБ», «Пер_СМБ»)).Copy  
   Set NewWb = ActiveWorkbook  
   For Each wsSh In NewWb.Worksheets  
       With wsSh  
           .Visible = True  
           .UsedRange.Value = .UsedRange.Value  
       End With  
   Next  

     For li = LBound(asArr) To UBound(asArr)  
       ThisWorkbook.Sheets(asArr(li)).Visible = xlSheetVeryHidden  
   Next li  
   NewWb.SaveAs Filename:=ActiveWorkbook.Path & «Копия.xls»  
   Application.ScreenUpdating = True  
   MsgBox «Формы документов перенесены в новую книгу и сохранены.», , «»  
End Sub  

  Однако снова возникли вопросы:  
1. Можно ли сохранить копируемые (а на самом деле — перемещаемые) листы в исходной книге иным способом или это возможно только с помощью закрытия исходной книги без сохранения?  
2. Есть ли способ защитить новосозданную книгу и ее листы таким образом, чтобы пользователю были недоступны никакие изменения, словно лист сохранился как картинка в pdf-формате?

 

ytk5kyky

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

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

1. Попробуйте все же мой код от 01.04.2010, 13:41  
2. Да можно. Можно защитить листы.  
Вставьте в мой код перед Next строчку:  
ActiveSheet.Protect Password:=»12345″  
Помните, что защита не стойкая. На форуме неоднократно это обсуждалось.  
Может и сохранить листы в пдф? Наберите в поиск напечатать в pdf  

  Кстати, мой код от 31.03.2010, 10:04 не работал из-за того, что все листы были скрытые. Достаточно один сделать видимым, как все копируются. Т.е. сначала  
Sheets(«П_СМБ»).Visible = True  
затем весь код  
и в конце скрываем  
ThisWorkbook.Sheets(«П_СМБ»).Visible = xlSheetVeryHidden  

  все циклы и массивы не нужны.

 

KuklP

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

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

E-mail и реквизиты в профиле.

Или так:  
Sub SaveSheet_SMB()  
ThisWorkbook.Unprotect («XXX»)  
Dim wsSh As Worksheet  
Dim NewWb As Workbook, asArr(), li As Long  
Application.ScreenUpdating = False  
For Each wsSh In Sheets(Array(«П_СМБ», «З_СМБ», «Пер_СМБ»))  
If wsSh.Visible <> -1 Then ReDim Preserve asArr(li): asArr(li) = wsSh.Name: li = li + 1: wsSh.Visible = xlSheetVisible  
Next wsSh  
Sheets(Array(«П_СМБ», «З_СМБ», «Пер_СМБ»)).Copy  
Set NewWb = ActiveWorkbook  
For Each wsSh In NewWb.Worksheets  
With wsSh.UsedRange  
.Copy  
wsSh.Range(.Address).PasteSpecial Paste:=xlPasteValues ‘Вот эта строка от Лузер™  
End With  
Next  

  For li = LBound(asArr) To UBound(asArr)  
ThisWorkbook.Sheets(asArr(li)).Visible = xlSheetVeryHidden  
Next li  
NewWb.SaveAs Filename:=ActiveWorkbook.Path & «Копия.xls»  
Application.ScreenUpdating = True  
MsgBox «Формы документов перенесены в новую книгу и сохранены.», , «»  
End Sub  
У меня работает.  
По поводу сохранения в PDF ссылаюсь на пост Лузер™.

Я сам — дурнее всякого примера! …

 

KuklP

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

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

E-mail и реквизиты в профиле.

Еше перед End Sub:  
ThisWorkbook.Protect («XXX»)

Я сам — дурнее всякого примера! …

 

Taysonss

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

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

#23

28.11.2010 23:48:56

А если сохранить новый файл с названием из определенной ячейки оригинального файла?  

  Sub SaveSheet_SMB()  
Sheets(«Учет»).Range(«$B$2») = Sheets(«1»).Range(«B2»)  
Dim wsSh As Worksheet  
Dim NewWb As Workbook, asArr(), li As Long  
Application.ScreenUpdating = False  
For Each wsSh In Sheets(Array(«1», «2»))  
If wsSh.Visible <> -1 Then ReDim Preserve asArr(li): asArr(li) = wsSh.Name: li = li + 1: wsSh.Visible = xlSheetVisible  
Next wsSh  
Sheets(Array(«1», «2»)).Copy  
Set NewWb = ActiveWorkbook  
For Each wsSh In NewWb.Worksheets  
With wsSh.UsedRange  
.Copy  
wsSh.Range(.Address).PasteSpecial Paste:=xlPasteValues ‘Вот эта строка от Лузер™  
End With  
Next  

    NewWb.SaveAs Filename:=Replace(ThisWorkbook.FullName, ThisWorkbook.Name, «1_2 «) & Sheets(«Учет»).Range(«B2»)& «.xls»  
For li = LBound(asArr) To UBound(asArr)  
ThisWorkbook.Sheets(asArr(li)).Visible = xlSheetVeryHidden  
Next li  
Application.ScreenUpdating = True  
MsgBox «Формы документов перенесены в новую книгу и сохранены.», , «»  

  Sheets(Array(«1», «2»)).Select  
Sheets(«1»).Activate  
ActiveWindow.SelectedSheets.PrintPreview  
‘Selection.PrintOut Copies:=1, Collate:=True  
ThisWorkbook.Save  
ThisWorkbook.Close  
End Sub  

  Отчего игнорируется & Sheets(«Учет»).Range(«B2»)& «.xls» ?  
Помогите как нибудь.

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

  • post_178976.xls (33 КБ)

You can easily copy sheets in Excel manually with a few simple mouse clicks. On the other hand, you need a macro if you want to automate this process. In this guide, we’re going to show you how to copy sheets in Excel with VBA.

Download Workbook

Before you start

If you are new to VBA and macro concept, VBA is a programming language for Office products. Microsoft allows users to automate tasks or modify properties of Office software. A macro, on the other hand, is a set of VBA code which you tell the machine what needs to be done.

Macros, or codes, should be written in modules, which are text areas in VBA’s dedicated user interface. Also, the file should be saved as Excel Macro Enabled Workbook in XLSM format to keep the codes.

You can find detailed instructions in our How to create a macro in Excel guide.

New Workbook

Copy active sheet to a new workbook

The first code is the simplest and shortest one which performs the action the title suggests:

Public Sub CopyActiveSheetToNewWorkbook()

  ActiveSheet.Copy

End Sub

As you can figure out ActiveSheet selector indicates the active sheet in the user window. Once the code run successfully, you will see the copy in a new workbook.

Copy a specific sheet to a new workbook

The following code copies “SUMIFS” sheet into a new workbook, regardless of sheet’s active status.

Public Sub CopySpecificSheetToNewWorkbook()

  Sheets("SUMIFS").Copy

End Sub

Copy selected sheets to a new workbook

If you need to copy selected sheets into a new workbook, use ActiveWindow.SelectedSheets selector.

Public Sub CopyActiveSheetsToNewWorkbook()

  ActiveWindow.SelectedSheets.Copy

End Sub

Copy active sheet to a specific position in the same workbook

If you specify a position in the code, VBA duplicates the sheet in a specific position of in the workbook. To do this placement, you can use Before and After arguments with Copy command. With these arguments, you can place the new sheet before or after an existing worksheet.

You can use either sheet names or their indexes to indicate the existing sheet. Here are a few samples:

Public Sub CopyActiveSheetAfterSheet_Name()

  'Copies the active sheet after "Types" sheet

  ActiveSheet.Copy After:=Sheets("Types")

End Sub

    

Public Sub CopyActiveSheetAfterSheet_Index()

  'Copies after 2nd sheet

  ActiveSheet.Copy After:=Sheets(2)

End Sub

    

Public Sub CopyActiveSheetAfterLastSheet()

  'Copies the active sheet after the last sheet

  'Sheets.Count command returns the number of the sheets in the workbook

  ActiveSheet.Copy After:=Sheets(Sheets.Count)

End Sub

    

Public Sub CopyActiveSheetBeforeSheet_Name()

  'Copies the active sheet before "Types" sheet

  ActiveSheet.Copy Before:=Sheets("Types")

End Sub

    

Public Sub CopyActiveSheetBeforeSheet_Index()

  'Copies the active sheet before 2nd sheet

  ActiveSheet.Copy Before:=Sheets(2)

End Sub

    

Public Sub CopyActiveSheetBeforeFirstSheet()

  'Copies the active sheet before the first sheet

  ActiveSheet.Copy Before:=Sheets(1)

End Sub

Copy active sheet to an existing workbook

To copy anything to an existing workbook, there are 2 perquisites:

  1. Target workbook should be open as well
  2. You need to specify the target workbooks by name
Sub CopySpecificSheetToExistingWorkbook()

  ' define a workbook variable and assign target workbook

  ' thus, we can use variable multiple times instead of workbook reference

  Dim targetSheet As Workbook

  Set targetSheet = Workbooks("Target Workbook.xlsx")

  'copies "Names" sheet to the last position in the target workbook

  Sheets("Names").Copy After:=targetSheet.Sheets(targetSheet.Worksheets.Count)

End Sub

Note: To copy to a closed workbook is possible. However, the target workbook should be opened and preferably closed after copying via VBA as well.

In this Article

  • Copy Worksheet to New Workbook
    • Copy ActiveSheet to New Workbook
  • Copy Multiple Sheets to New Workbook
  • Copy Sheet Within Same Workbook
    • Copy Sheet Before Another Sheet
    • Copy Sheet Before First Sheet
    • Copy Sheet After Last Sheet
  • Move Sheet
  • Copy and Name Sheet
    • Copy and Name Sheet Based on Cell Value
  • Copy Worksheet to Another Workbook
  • Copy Worksheet to a Closed Workbook
  • Copy Sheet from Another Workbook Without Opening it
  • Duplicate Excel Sheet Multiple times

This tutorial will cover how to copy a Sheet or Worksheet using VBA.

Copy Worksheet to New Workbook

To copy a Worksheet to a new Workbook:

Sheets("Sheet1").Copy

Copy ActiveSheet to New Workbook

To copy the ActiveSheet to a new Workbook:

ActiveSheet.Copy

Copy Multiple Sheets to New Workbook

To copy multiple Sheets to a new workbook:

ActiveWindow.SelectedSheets.Copy

Copy Sheet Within Same Workbook

We started off by showing you the most simple copy Sheets example: copying Sheet(s) to a new Workbook.  These examples below will show you how to copy a Sheet within the same Workbook. When copying a Sheet within a Worbook, you must specify a location.  To specify a location, you will tell VBA to move the Worksheet BEFORE or AFTER another Worksheet.

Copy Sheet Before Another Sheet

Here we will specify to copy and paste the Sheet before Sheet2

Sheets("Sheet1").Copy Before:=Sheets("Sheet2")

Copy Sheet Before First Sheet

Instead of specifying the Sheet name, you can also specify the Sheet position. Here we are copying and pasting a Sheet before the first Sheet in the Workbook.

Sheets("Sheet1").Copy Before:=Sheets(1)

The newly created Sheet will now be the first Sheet in the Workbook.
vba copy sheet before first sheet

VBA Coding Made Easy

Stop searching for VBA code online. Learn more about AutoMacro — A VBA Code Builder that allows beginners to code procedures from scratch with minimal coding knowledge and with many time-saving features for all users!

automacro

Learn More

Copy Sheet After Last Sheet

Use the After property to tell VBA to paste the Sheet AFTER another sheet. Here we will copy and paste a Sheet after the last Sheet in the Workbook:

Sheets("Sheet1").Copy After:=Sheets(Sheets.Count)

Notice that we used Sheets.Count to count the number of Sheets in the Workbook.

vba copy after last sheet

Move Sheet

You can also move a Sheet within a Workbook using similar syntax. This code will move Sheet1 to the end of the Workbook:

Sheets("Sheet1").Move After:=Sheets(Sheets.Count)

Copy and Name Sheet

After copying and pasting a Sheet, the newly created sheet becomes the ActiveSheet. So to rename our new sheet, simply use ActiveSheet.Name:

Sub CopySheetRename1()

Sheets("Sheet1").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = "LastSheet"

End Sub

If the Sheet name already exists, the above code will generate an error.  Instead we can use “On Error Resume Next” to tell VBA to ignore naming the Sheet and proceed with the rest of the procedure:

Sub CopySheetRename2()

    Sheets("Sheet1").Copy After:=Sheets(Sheets.Count)
    On Error Resume Next
    ActiveSheet.Name = "LastSheet"
    On Error GoTo 0

End Sub

Or use our RangeExists Function to test if the Sheet name already exists before attempting to copy the sheet:

Sub CopySheetRename3()

    If RangeExists("LastSheet") Then
        MsgBox "Sheet already exists."
    Else
        Sheets("Sheet1").Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = "LastSheet"
    End If

End Sub

Function RangeExists(WhatSheet As String, Optional ByVal WhatRange As String = "A1") As Boolean
    Dim test As Range
    On Error Resume Next
    Set test = ActiveWorkbook.Sheets(WhatSheet).Range(WhatRange)
    RangeExists = Err.Number = 0
    On Error GoTo 0
End Function

VBA Programming | Code Generator does work for you!

Copy and Name Sheet Based on Cell Value

You might also want to copy and name a Sheet based on a Cell Value.  This code will name the Worksheet based on the Cell value in A1

Sub CopySheetRenameFromCell()

    Sheets("Sheet1").Copy After:=Sheets(Sheets.Count)
    On Error Resume Next
    ActiveSheet.Name = Range("A1").Value
    On Error GoTo 0

End Sub

Copy Worksheet to Another Workbook

So far we’ve worked with copying Sheets within a Workbook. Now we will cover examples to copy and paste Sheets to other Workbooks. This code will copy a Sheet to the beginning of another workbook:

Sheets("Sheet1").Copy Before:=Workbooks("Example.xlsm").Sheets(1)

This will copy a Worksheet to the end of another Workbook.

Sheets("Sheet1").Copy After:=Workbooks("Example.xlsm").Sheets(Workbooks("Example.xlsm").Sheets.Count)

Notice we replaced 1 with Workbooks(“Example.xlsm”).Sheets.Count to get the last Worksheet.

Copy Worksheet to a Closed Workbook

You might also want to copy a Worksheet to a Workbook that is closed.  This code will open a closed Workbook so that you can copy a Sheet into it.

Sub CopySheetToClosedWB()
Application.ScreenUpdating = False

    Set closedBook = Workbooks.Open("D:Dropboxexcelarticlesexample.xlsm")
    Sheets("Sheet1").Copy Before:=closedBook.Sheets(1)
    closedBook.Close SaveChanges:=True

Application.ScreenUpdating = True
End Sub

Copy Sheet from Another Workbook Without Opening it

Conversely, this code will copy a Worksheet FROM a closed Workbook without you needing to manually open the workbook.

Sub CopySheetFromClosedWB()
Application.ScreenUpdating = False

    Set closedBook = Workbooks.Open("D:Dropboxexcelarticlesexample.xlsm")
    closedBook.Sheets("Sheet1").Copy Before:=ThisWorkbook.Sheets(1)
    closedBook.Close SaveChanges:=False

Application.ScreenUpdating = True
End Sub

Notice that in both these examples we disabled ScreenUpdating so the process runs in the background.

Duplicate Excel Sheet Multiple times

You can also duplicate an Excel Sheet multiple times by using a Loop.

Sub CopySheetMultipleTimes()
Dim n As Integer
Dim i As Integer
On Error Resume Next

    n = InputBox("How many copies do you want to make?")

    If n > 0 Then
        For i = 1 To n
            ActiveSheet.Copy After:=ActiveWorkbook.Sheets(Worksheets.Count)
        Next
    End If

End Sub

vba duplicate sheet

Содержание

  • Копировать лист в новую книгу
  • Копировать несколько листов в новую книгу
  • Копировать лист в той же книге
  • Переместить лист
  • Копия и имя листа
  • Копировать лист в другую книгу
  • Копировать лист в закрытую книгу
  • Копировать лист из другой книги, не открывая ее
  • Дублируйте лист 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)СледующийКонец, еслиКонец подписки

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

Понравилась статья? Поделить с друзьями:
  • Excel vba копировать значение ячейки
  • Excel vba копировать в буфер обмена
  • Excel vba копирование ячеек с форматированием
  • Excel vba копирование таблиц
  • Excel vba копирование строки на другой лист