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

So, what I want to do, generally, is make a copy of a workbook. However, the source workbook is running my macros, and I want it to make an identical copy of itself, but without the macros. I feel like there should be a simple way to do this with VBA, but have yet to find it. I am considering copying the sheets one by one to the new workbook, which I will create. How would I do this? Is there a better way?

asked Jul 28, 2011 at 18:34

I would like to slightly rewrite keytarhero’s response:

Sub CopyWorkbook()

Dim sh as Worksheet,  wb as workbook

Set wb = workbooks("Target workbook")
For Each sh in workbooks("source workbook").Worksheets
   sh.Copy After:=wb.Sheets(wb.sheets.count) 
Next sh

End Sub

Edit: You can also build an array of sheet names and copy that at once.

Workbooks("source workbook").Worksheets(Array("sheet1","sheet2")).Copy _
         After:=wb.Sheets(wb.sheets.count)

Note: copying a sheet from an XLS? to an XLS will result into an error. The opposite works fine (XLS to XLSX)

answered Jul 28, 2011 at 21:05

iDevlopiDevlop

24.6k11 gold badges89 silver badges147 bronze badges

Someone over at Ozgrid answered a similar question. Basically, you just copy each sheet one at a time from Workbook1 to Workbook2.

Sub CopyWorkbook()

    Dim currentSheet as Worksheet
    Dim sheetIndex as Integer
    sheetIndex = 1

    For Each currentSheet in Worksheets

        Windows("SOURCE WORKBOOK").Activate 
        currentSheet.Select
        currentSheet.Copy Before:=Workbooks("TARGET WORKBOOK").Sheets(sheetIndex) 

        sheetIndex = sheetIndex + 1

    Next currentSheet

End Sub

Disclaimer: I haven’t tried this code out and instead just adopted the linked example to your problem. If nothing else, it should lead you towards your intended solution.

answered Jul 28, 2011 at 19:05

Chris FlynnChris Flynn

9536 silver badges11 bronze badges

You could saveAs xlsx. Then you will loose the macros and generate a new workbook with a little less work.

ThisWorkbook.saveas Filename:=NewFileNameWithPath, Format:=xlOpenXMLWorkbook

answered Jul 28, 2011 at 20:55

BradBrad

11.9k4 gold badges44 silver badges70 bronze badges

I was able to copy all the sheets in a workbook that had a vba app running, to a new workbook w/o the app macros, with:

ActiveWorkbook.Sheets.Copy

answered Feb 28, 2014 at 17:50

Assuming all your macros are in modules, maybe this link will help. After copying the workbook, just iterate over each module and delete it

answered Jul 28, 2011 at 18:59

ravenraven

4376 silver badges17 bronze badges

Try this instead.

Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
    ws.Copy
Next

ZygD

21k39 gold badges77 silver badges98 bronze badges

answered Jan 17, 2013 at 21:28

You can simply write

Worksheets.Copy

in lieu of running a cycle.
By default the worksheet collection is reproduced in a new workbook.

It is proven to function in 2010 version of XL.

iDevlop

24.6k11 gold badges89 silver badges147 bronze badges

answered Feb 17, 2015 at 14:25

Hors2forceHors2force

1011 silver badge2 bronze badges

    Workbooks.Open Filename:="Path(Ex: C:ReportsClientWiseReport.xls)"ReadOnly:=True


    For Each Sheet In ActiveWorkbook.Sheets

        Sheet.Copy After:=ThisWorkbook.Sheets(1)

    Next Sheet

answered Feb 22, 2013 at 11:39

Here is one you might like it uses the Windows FileDialog(msoFileDialogFilePicker) to browse to a closed workbook on your desktop, then copies all of the worksheets to your open workbook:

Sub CopyWorkBookFullv2()
Application.ScreenUpdating = False

Dim ws As Worksheet
Dim x As Integer
Dim closedBook As Workbook
Dim cell As Range
Dim numSheets As Integer
Dim LString As String
Dim LArray() As String
Dim dashpos As Long
Dim FileName As String

numSheets = 0

For Each ws In Application.ActiveWorkbook.Worksheets
    If ws.Name <> "Sheet1" Then
       Sheets.Add.Name = "Sheet1"
   End If
Next

Dim fileExplorer As FileDialog
Set fileExplorer = Application.FileDialog(msoFileDialogFilePicker)
Dim MyString As String

fileExplorer.AllowMultiSelect = False

  With fileExplorer
     If .Show = -1 Then 'Any file is selected
     MyString = .SelectedItems.Item(1)

     Else ' else dialog is cancelled
        MsgBox "You have cancelled the dialogue"
        [filePath] = "" ' when cancelled set blank as file path.
        End If
    End With

    LString = Range("A1").Value
    dashpos = InStr(1, LString, "") + 1
    LArray = Split(LString, "")
    'MsgBox LArray(dashpos - 1)
    FileName = LArray(dashpos)

strFileName = CreateObject("WScript.Shell").specialfolders("Desktop") & "" & FileName

Set closedBook = Workbooks.Open(strFileName)
closedBook.Application.ScreenUpdating = False
numSheets = closedBook.Sheets.Count

        For x = 1 To numSheets
            closedBook.Sheets(x).Copy After:=ThisWorkbook.Sheets(1)
        x = x + 1
                 If x = numSheets Then
                    GoTo 1000
                 End If
Next

1000

closedBook.Application.ScreenUpdating = True
closedBook.Close
Application.ScreenUpdating = True

End Sub

answered Apr 5, 2020 at 22:26

try this one

Sub Get_Data_From_File()

     'Note: In the Regional Project that's coming up we learn how to import data from multiple Excel workbooks
    ' Also see BONUS sub procedure below (Bonus_Get_Data_From_File_InputBox()) that expands on this by inlcuding an input box
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
         'copy data from A1 to E20 from first sheet
        OpenBook.Sheets(1).Range("A1:E20").Copy
        ThisWorkbook.Worksheets("SelectFile").Range("A10").PasteSpecial xlPasteValues
        OpenBook.Close False
        
    End If
    Application.ScreenUpdating = True
End Sub

or this one:

Get_Data_From_File_InputBox()

Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim ShName As String
Dim Sh As Worksheet
On Error GoTo Handle:

FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*.xls*")
Application.ScreenUpdating = False
Application.DisplayAlerts = False

If FileToOpen <> False Then
    Set OpenBook = Application.Workbooks.Open(FileToOpen)
    ShName = Application.InputBox("Enter the sheet name to copy", "Enter the sheet name to copy")
    For Each Sh In OpenBook.Worksheets
        If UCase(Sh.Name) Like "*" & UCase(ShName) & "*" Then
            ShName = Sh.Name
        End If
    Next Sh

    'copy data from the specified sheet to this workbook - updae range as you see fit
    OpenBook.Sheets(ShName).Range("A1:CF1100").Copy
    ThisWorkbook.ActiveSheet.Range("A10").PasteSpecial xlPasteValues
    OpenBook.Close False
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub

Handle:
If Err.Number = 9 Then
MsgBox «The sheet name does not exist. Please check spelling»
Else
MsgBox «An error has occurred.»
End If
OpenBook.Close False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

both work as

answered Jul 6, 2020 at 4:26

Источник

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

Источник

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:

Target workbook should be open as well
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.

Источник

Уважаемые форумчане! Честно искала в форуме, находила, но не смогла переделать найденный код под свои нужды. Проблема такая: в книге много скрытых листов, надо сохранить в новую книгу несколько листов таким образом, чтобы копировались только значения ячеек и элементов управления на листе и пользователь мог только смотреть и распечатывать содержимое (словно картинкой листы копировались).
Нашла в инете код для одного листа, но при копировании часть текста теряется, плюс не знаю, как вставить в процедуру еще несколько листов:
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

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

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 КБ)

Источник

Содержание

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

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

Источник

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Before you start

New Workbook

Copy active sheet to a new workbook

Copy a specific sheet to a new workbook

Copy selected sheets to a new workbook

Copy active sheet to a specific position in the same workbook

Copy active sheet to an existing workbook

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

А вот еще интересные статьи: