Копировать страницу 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, смотрите в этой статье.

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

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.

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?

Martijn Pieters's user avatar

asked Jul 28, 2011 at 18:34

Brian's user avatar

1

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

iDevlop's user avatar

iDevlopiDevlop

24.6k11 gold badges89 silver badges147 bronze badges

3

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.

Community's user avatar

answered Jul 28, 2011 at 19:05

Chris Flynn's user avatar

Chris FlynnChris Flynn

9536 silver badges11 bronze badges

2

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

Brad's user avatar

BradBrad

11.9k4 gold badges44 silver badges70 bronze badges

2

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

Prashant Kumar's user avatar

answered Feb 28, 2014 at 17:50

George Ziniewicz's user avatar

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

Community's user avatar

answered Jul 28, 2011 at 18:59

raven's user avatar

ravenraven

4376 silver badges17 bronze badges

Try this instead.

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

ZygD's user avatar

ZygD

21k39 gold badges77 silver badges98 bronze badges

answered Jan 17, 2013 at 21:28

Ch3knraz3's user avatar

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's user avatar

iDevlop

24.6k11 gold badges89 silver badges147 bronze badges

answered Feb 17, 2015 at 14:25

Hors2force's user avatar

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

Sainath J's user avatar

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

RWB's user avatar

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

Silvio Rivas's user avatar

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

Вручную копировать листы в Excel довольно быстро и просто… если делать это один или два раза. Дублирование нескольких листов несколько раз утомительно и отнимает много времени. На этой странице вы найдете несколько полезных макросов для автоматизации этой задачи.

Этот простейший однострочный макрос делает именно то, что следует из его названия — копирует активный лист в новую книгу.

Public Sub CopySheetToNewWorkbook() activeSheet.Copy End Sub

Скопируйте несколько листов в Excel с помощью VBA

Если вы хотите скопировать несколько листов из активной книги в новую, выберите все интересующие листы и запустите этот макрос:

Public Sub CopySelectedSheets() ActiveWindow.SelectedSheets.Copy End Sub

Excel VBA для копирования листа в другую книгу

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

Скопировать лист в начало другой книги

Этот макрос копирует активный лист перед всеми остальными рабочими листами в целевом файле, Книга1 в этом примере. Чтобы скопировать в другой файл, замените «Book1.xlsx» полным именем целевой книги.

Public Sub CopySheetToBeginningAnotherWorkbook() activeSheet.Copy Before:=Workbooks(«Book1.xlsx»).Sheets(1) End Sub

Скопировать лист в конец другой книги

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

Public Sub CopySheetToEndAnotherWorkbook() activeSheet.Copy After:=Workbooks(«Book1.xlsx»).Sheets(Workbooks(«Book1.xlsx»).Worksheets.Count) End Sub

Примечание. Чтобы макросы работали, целевая книга должна быть сохранена на жестком диске или в сети.

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

Чтобы иметь возможность скопировать текущий лист в любую открытую книгу, вы можете создать пользовательскую форму (с именем Пользовательская форма1) с СписокБокс контроль (с именем ListBox1) и две кнопки:
Создание пользовательской формы для копирования листа в любую открытую книгу

Затем дважды щелкните форму и вставьте приведенный ниже код в окно кода:

Public SelectedWorkbook As String Private Sub UserForm_Initialize() SelectedWorkbook = «» ListBox1.Clear For Each wbk In Application.Workbooks ListBox1.AddItem (wbk.Name) Next End Sub Private Sub CommandButton1_Click() If ListBox1.ListIndex > -1 Then SelectedWorkbook = ListBox1 .List(ListBox1.ListIndex) End If Me.Hide End Sub Private Sub CommandButton2_Click() SelectedWorkbook = «» Me.Hide End Sub

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

Копировать лист в начало выбранной книги:

Public Sub CopySheetToBeginningAnotherWorkbook() Загрузить UserForm1 UserForm1.Show If (UserForm1.SelectedWorkbook <> «») Then activeSheet.Copy Before:=Workbooks(UserForm1.SelectedWorkbook).Sheets(1) End If Unload UserForm1 End Sub

Копировать лист в конец выбранной книги:

Public Sub CopySheetToEndAnotherWorkbook() Загрузить UserForm1 UserForm1.Show If (UserForm1.SelectedWorkbook <> «») Then activeSheet.Copy After:=Workbooks( _ UserForm1.SelectedWorkbook).Sheets( _ Workbooks(UserForm1.SelectedWorkbook). _ Worksheets.Count) End If Unload UserForm1 End Sub

При запуске в Excel макрос покажет вам список всех открытых книг. Вы выбираете нужный и нажимаете ОК:
Макрос для копирования активного листа в выбранную книгу

Макрос Excel для копирования листа и переименования

Когда вы копируете лист в Excel, реплике присваивается имя в формате по умолчанию, например Лист1 (2). Следующие макросы могут избавить вас от необходимости вручную изменять имя по умолчанию.

Этот код дублирует активный лист, называет копию «Тестовый лист» (вы можете заменить его любым другим именем) и помещает скопированный лист в конец текущей книги.

Public Sub CopySheetAndRenamePredefined() activeSheet.Copy After:=Worksheets(Sheets.Count) При ошибке Возобновить Далее activeSheet.Name = «Test Sheet» End Sub

Чтобы позволить пользователю указать имя для скопированного листа, используйте этот код:

Public Sub CopySheetAndRename() Dim newName As String On Error Resume Next newName = InputBox(«Введите имя скопированного рабочего листа») If newName <> «» Then activeSheet.Copy After:=Worksheets(Sheets.Count) On Error Resume Next activeSheet.Name = newName End If End Sub

После запуска макрос отображает следующее поле ввода, в котором вы вводите желаемое имя и нажимаете OK:
Макрос Excel для копирования листа и переименования

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

В некоторых ситуациях может быть удобнее назвать копию конкретным значением ячейки, например, заголовком столбца. Для этого вы просто берете приведенный выше код и автоматически вводите значение текущей выбранной ячейки в поле ввода. Как и в предыдущем примере, копия будет помещена в конец активной книги.
Макрос Excel для копирования листа и переименования на основе значения ячейки

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

Public Sub CopySheetAndRenameByCell() Dim newName As String On Error Resume Next newName = InputBox(«Введите имя скопированного рабочего листа», «Копировать рабочий лист», ActiveCell.Value) If newName <> «» Then activeSheet.Copy After:=Worksheets (Sheets.Count) При ошибке возобновить следующий activeSheet.Name = newName End If End Sub

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

Public Sub CopySheetAndRenameByCell2() Dim wks As Worksheet Set wks = activeSheet activeSheet.Copy After:=Worksheets(Sheets.Count) If wks.Range(«A1»).Value <> «» Then On Error Resume Next activeSheet.Name = wks .Range(«A1»).Value End If wks.Activate End Sub

Макрос для копирования рабочего листа в закрытую книгу

Этот макрос копирует активный лист в конец закрытой книги. Имя другой книги в коде не указано — макрос откроет стандартное окно проводника Windows и позволит выбрать любой файл назначения:
Макрос для копирования рабочего листа в закрытую книгу

После выбора файла и нажатия Открытыммакрос скопирует активный лист и автоматически закроет целевую книгу.

Public Sub CopySheetToClosedWorkbook() Dim fileName Dim closedBook As Workbook Dim currentSheet As Worksheet fileName = Application.GetOpenFilename(«Excel Files (*.xlsx), *.xlsx») If fileName <> False Then Application.ScreenUpdating = False Set currentSheet = Application .activeSheet Set ClosedBook = Workbooks.Open(fileName) currentSheet.Copy After:=closedBook.Sheets(closedBook.Worksheets.Count) closedBook.Close (True) Application.ScreenUpdating = True End If End Sub

Excel VBA для копирования листа из другой книги без открытия

Этот макрос позволяет скопировать лист из другого файла Excel, не открывая его. Скопированный лист будет вставлен в конец текущей книги.

Только не забудьте сделать пару замен в коде:

  • C:UsersXXXDocumentsTarget_Book.xlsx следует изменить на фактический путь и имя книги, из которой вы хотите скопировать лист.
  • Sheet1 следует заменить именем листа, который вы хотите скопировать.

Public Sub CopySheetFromClosedWorkbook() Dim sourceBook As Workbook Application.ScreenUpdating = False Set sourceBook = Workbooks.Open(«C:UsersXXXDocumentsTarget_Book.xlsx») sourceBook.Sheets(«Sheet1»).Копировать после:=ThisWorkbook .Sheets(ThisWorkbook.Sheets.Count) sourceBook.Close Application.ScreenUpdating = True End Sub

Excel VBA для дублирования листа несколько раз

Иногда может потребоваться продублировать один и тот же лист более одного раза, например, для проверки разных формул на одном и том же наборе данных. Это легко сделать с помощью следующего макроса.

Public Sub DuplicateSheetMultipleTimes() Dim n As Integer On Error Resume Next n = InputBox(«Сколько копий активного листа вы хотите сделать?») Если n >= 1 Then For numtimes = 1 To n activeSheet.Copy After: =ActiveWorkbook.Sheets(Worksheets.Count) Next End If End Sub

Откройте исходный лист, запустите макрос, укажите, сколько копий активного листа вы хотите сделать, и нажмите ХОРОШО:
Excel VBA для дублирования листа несколько раз

Как дублировать листы в Excel с помощью VBA

Чтобы скопировать лист в Excel одним из вышеперечисленных макросов, вы можете либо вставить код VBA в свою книгу, либо запустить макрос из нашего образец рабочей тетради.

Как добавить макрос в книгу

Чтобы вставить код в книгу, выполните следующие действия:

  1. Откройте рабочий лист, который вы хотите скопировать.
  2. Нажмите Alt + F11, чтобы открыть редактор Visual Basic.
  3. На левой панели щелкните правой кнопкой мыши Эта рабочая тетрадьа затем щелкните Вставлять > Модуль.
  4. Вставьте код в окно кода.
  5. Нажмите F5, чтобы запустить макрос.

Подробные пошаговые инструкции см. в разделе Как вставить код VBA в Excel.

Как запустить макрос из нашего образца книги

Кроме того, вы можете загрузить наш образец рабочей тетради на Дублирование листов Excel и запустить код оттуда.

Образец книги содержит следующие макросы:

Копипшиттоневворкбук — копирует текущий рабочий лист в новую рабочую книгу.

Копировать выбранные листы — копирует несколько выбранных листов в новую книгу.

CopySheetToBeginningAnotherWorkbook — копирует активный лист в начало другой книги.

CopySheetToEndAnotherWorkbook — копирует активный лист в конец другого файла Excel.

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

CopySheetAndRenamePredefined — дублирует активный лист, дает копии жестко заданное имя и помещает ее в конец текущей рабочей книги.

Копилист и переименовать по ячейке — делает копию активного листа и переименовывает его на основе выбранного значения ячейки.

Копилист и переименовать по ячейке2 — копирует активный лист и переименовывает его на основе жестко заданного адреса ячейки.

Копипшиттоклоседворкбук — позволяет копировать лист в закрытую книгу.

CopySheetFromClosedWorkbook — позволяет скопировать лист из другого файла Excel, не открывая его.

ДубликатлистМультиплетаймс — позволяет дублировать лист в Excel несколько раз.

Чтобы запустить макрос в Excel, просто сделайте следующее:

  1. Откройте загруженную книгу и включите содержимое, если будет предложено.
  2. Откройте свою книгу и перейдите к листу, который хотите скопировать.
  3. На листе нажмите Alt + F8, выберите интересующий макрос и нажмите «Выполнить».

Скопируйте лист в Excel с помощью макроса.

Вот как вы можете дублировать лист в Excel с помощью VBA. Я благодарю вас за чтение и надеюсь увидеть вас в нашем блоге на следующей неделе!

Вас также могут заинтересовать

Понравилась статья? Поделить с друзьями:

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

  • Копировать столбец excel vba
  • Копировать стиль ячейки excel
  • Копировать содержимое ячейки excel формула
  • Копировать содержимое ячейки excel в другую ячейку
  • Копировать макрос макросом excel

  • 0 0 голоса
    Рейтинг статьи
    Подписаться
    Уведомить о
    guest

    0 комментариев
    Старые
    Новые Популярные
    Межтекстовые Отзывы
    Посмотреть все комментарии