Vba excel копирование листа в новую книгу

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

Источник

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

Источник

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

Источник
 

Добрый день!  
Знаю, как скопировать лист в новую книгу с переносом всех значений и защитить ячейки от изменений (спасибо планете!):  

     Dim wsSh As Worksheet  
   Dim NewWb As Workbook, asArr(), li As Long  
   DateString = Format(Now, «dd-mm-yy hh-mm-ss»)  
   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              
           .Cells.Locked = True  
           .Cells.FormulaHidden = True  
           .Protect Password:=MyPassword, DrawingObjects:=True, Contents:=True, Scenarios:=True  
           .EnableSelection = xlNoSelection  
       End With  
   Next  
   NewWb.SaveAs Filename:=ActiveWorkbook.Path & DateString & «_Заявление.xls»  
   Application.ScreenUpdating = True  
   ThisWorkbook.Close SaveChanges:=False  

    А мне надо, чтобы при копировании листа диапазон [A1:Z266] переносился в виде значений (а не формул) с защитой от изменений, а все остальное, где хоть что-то есть, с сохранением формул и без защиты. Подскажите, пожалуйста, как это сделать?
 

GIG_ant

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

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

Если вам нужно так сделать на каждом листе в новой книге то измените эту часть:  

  With wsSh  
.Visible = True    
.[A1:Z266].Value = .[A1:Z266].Value
.Cells.Locked = False  
.[A1:Z266].Locked = True
.[A1:Z266].FormulaHidden = True
.Protect Password…..
 

Спасибо, все получилось! Скажите, а возможно ли при переносе защитить от изменений формы управления — флажки?
 

Юрий М

Модератор

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

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

Если состояние флажков нельзя менять — для чего они тогда вообще? При копировании листа их состояние не меняется.
 

{quote}{login=Юрий М}{date=26.09.2011 08:59}{thema=}{post}Если состояние флажков нельзя менять — для чего они тогда вообще? При копировании листа их состояние не меняется.{/post}{/quote}  

  Это я заметила. Суть в том, чтобы пользователь, поработав с формами (которые содержат расчетную часть и проверки корректности) на выходе получил документы, состояние которых уже нельзя поменять. Я понимаю, что можно на выходе делать документы, содержащие только выбранные значения. Но на данный момент задача заключается в том, чтобы получить документ, доступный для изменений с тем же успехом, как картинка jpg.
 

nerv

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

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

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

  установите виртуальный принтер и печатайте в pdf  
doPDF
 

{quote}{login=nerv}{date=27.09.2011 01:21}{thema=}{post}>>Но на данный момент задача заключается в том, чтобы получить документ, доступный для изменений с тем же успехом, как картинка jpg  

  установите виртуальный принтер и печатайте в pdf  
doPDF{/post}{/quote}  

  Да, думала о таком решении и надеюсь реализовать :)

 

{quote}{login=Black__Hole}{date=26.09.2011 02:20}{thema=vba: копирование листа в новую книгу}{post}Добрый день!  
Знаю, как скопировать лист в новую книгу с переносом всех значений и защитить ячейки от изменений (спасибо планете!):  

     Dim wsSh As Worksheet  
   Dim NewWb As Workbook, asArr(), li As Long  
   DateString = Format(Now, «dd-mm-yy hh-mm-ss»)  
   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              
           .Cells.Locked = True  
           .Cells.FormulaHidden = True  
           .Protect Password:=MyPassword, DrawingObjects:=True, Contents:=True, Scenarios:=True  
           .EnableSelection = xlNoSelection  
       End With  
   Next  
   NewWb.SaveAs Filename:=ActiveWorkbook.Path & DateString & «_Заявление.xls»  
   Application.ScreenUpdating = True  
   ThisWorkbook.Close SaveChanges:=False  

    А мне надо, чтобы при копировании листа диапазон [A1:Z266] переносился в виде значений (а не формул) с защитой от изменений, а все остальное, где хоть что-то есть, с сохранением формул и без защиты. Подскажите, пожалуйста, как это сделать?{/post}{/quote}

  Скажите, пожалуйста, а как сделать так, чтобы копировались два листа на новую книгу? То есть два листа с одной книги (как в примере «Заявление», и ещё допустим второй «Образец») в один новый файл?
 

Дорогие мужчины, ответье пожалуйса! Очень нужно :'(
 

ZVI

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

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

Для копирования 2-х листов  
Вместо: Sheets(Array(«Заявление»)).Copy  
Должно быть: Sheets(Array(«Заявление», «Образец»)).Copy
 

{quote}{login=ZVI}{date=16.01.2012 09:12}{thema=}{post}Для копирования 2-х листов  
Вместо: Sheets(Array(«Заявление»)).Copy  
Должно быть: Sheets(Array(«Заявление», «Образец»)).Copy{/post}{/quote}  

  Спасибо большое ZVI! Вы молодец! :)  
А что надо написать в этом макросе чтобы он спрашивал меня куда сохранять этот файл?  
И чтобы к имени ещё прибавлял значение из ячейки, которая не меняется?  

  Скажите, пожалуйста :(

 

nerv

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

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

Малышка Стьюи, надо перечислить n-ую сумму на следующие реквизиты… ]:->
 

{quote}{login=nerv}{date=16.01.2012 01:21}{thema=}{post}Малышка Стьюи, надо перечислить n-ую сумму на следующие реквизиты… ]:->{/post}{/quote}  

  Ну помогите пожалуйста, если знаете :( На данный момент я не располагаю достаточными финансами :((((((((
 

слэн

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

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

вот вернется ZVI — он главный знаток и филантроп :)

 

nerv

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

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

>Ну помогите пожалуйста, если знаете :( На данный момент я не располагаю достаточными финансами :((((((((  
На интернет, я смотрю, деньги нашли ^_^  

  Правильно слэн говорит, ждите ZVI : )
 

ууу, злые жители Планеты, всё бы вам на бедных девушках наживаться )))  
я вон с октября сижу без работы и ничего … ещё не помер с голоду ))    

  Sub test()  
   Dim wsSh As Worksheet, NewWb As Workbook, asArr(), li As Long, DateString As String  
   Dim MyPassword As String, iPath As String  

     DateString = Format(Now, «dd-mm-yy hh-mm-ss»)  
   Application.ScreenUpdating = False  
   For Each wsSh In Worksheets  
       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  
   MyPassword = «1»    ‘ПАРОЛЬ ЛИСТА  
   For Each wsSh In NewWb.Worksheets  
       With wsSh  
           .Visible = True  
           .UsedRange.Value = .UsedRange.Value  
           .Cells.Locked = True  
           .Cells.FormulaHidden = True  
           .Protect Password:=MyPassword, DrawingObjects:=True, Contents:=True, Scenarios:=True  
           .EnableSelection = xlNoSelection  
       End With  
   Next  

     With Application.FileDialog(msoFileDialogFolderPicker)  
       .Title = «Укажите папку»  
       .Show  
       If .SelectedItems.Count = 0 Then Exit Sub  
       iPath = .SelectedItems(1) & Application.PathSeparator  
   End With  

     NewWb.SaveAs Filename:=iPath & DateString & «_Заявление.xls»  
   NewWb.Close  
   Application.ScreenUpdating = True  
   ‘ThisWorkbook.Close SaveChanges:=False  
   MsgBox «Листы ‘Заявление’ и ‘Образец’ сохранены в папку: » & iPath, vbInformation, «Конец»  
End Sub
 

ZVI

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

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

Во дела! Павел, спасибо, что подстраховали, а то пока некогда, а до вечера далеко ещё.  

  Слэн, привет. Для нас с Павлом (филантропов) интересные девушки не потом! :-)

 

nerv

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

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

>я вон с октября сижу без работы и ничего … ещё не помер с голоду ))    
А семья? Как, нормально себя чувствует?) А если серьезно: слишком много халявы на Планете (мое мнение). Даже для тех, кто не прикладывает никаких усилий для решения задачи (клянчить не в счет).  

  >а до вечера далеко ещё  
Кому далеко, а кому час-другой)  

  школьные оценки  
20212
 

{quote}{login=Степлер}  
я вон с октября сижу без работы и ничего … ещё не помер с голоду ))    
{/post}{/quote}  

  Степлер, здравствуйте!  
Напишите, пожалуйста 0191077@gmail.com
 

Спасибо. Писать не буду )  

  P.S. Если хотите отблагодарить, скажите мне просто спасибо (данный код не стоит больше :) ), если хотите что-то спросить по Excel спрашивайте тут, мы поможем )
 

{quote}{login=Степлер}{date=16.01.2012 06:00}{thema=}{post}Спасибо. Писать не буду )  

  P.S. Если хотите отблагодарить, скажите мне просто спасибо (данный код не стоит больше :) ), если хотите что-то спросить по Excel спрашивайте тут, мы поможем ){/post}{/quote}  

  Степлер, Вы неверно меня поняли. Вы мне ничего еще не сделали, чтобы я Вас благодарил ;) Я Вам скажу спасибо, если свяжитесь со мной.  
У меня есть задача слишком сложная для меня.
 

поэтому я и написал «если хотите что-то спросить по Excel спрашивайте тут, мы поможем )»  

  Создайте тему с вашим вопросом и файлом-примреом, а мы посмотрим, чем вам можем помочь.  

  P.S. Я не пишу никому на почту
 

Юрий М

Модератор

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

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

У Степлера просто нет почтового ящика — как он может написать?
 

{quote}{login=Степлер}{date=16.01.2012 06:21}{thema=}{post}поэтому я и написал «если хотите что-то спросить по Excel спрашивайте тут, мы поможем )»  

  Создайте тему с вашим вопросом и файлом-примреом, а мы посмотрим, чем вам можем помочь.  

  P.S. Я не пишу никому на почту{/post}{/quote}  

  Степлер, у меня есть задача, которую нужно сделать. Мне не нужна помощь, мне нужно сделать полностью от и до. Форум мне не подъодит, так как нужно, чтобы кто-то отвечал за результат и сроки. Вам это интересно? По почте вышлю подробное описание.
 

Спасибо, мне это не интересно
 

nerv

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

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

>данный код не стоит больше  
Степлер, Павел, если не ошибаюсь : ) Не сочтите за труд, сходите по этой (см. ниже) ссылке и прочитайте то, что в блоке с пометкой «цитата».  

<EM>http://forum.htmlbook.ru/index.php?showtopic=31842&view=findpost&p=240273</EM>
 

Степлер

Гость

#27

17.01.2012 01:39:33

Да, Саш, меня зовут Павел. Мой прошлый ник Pavel55. Я последнее время меняю свои ники каждую неделю.  
Сходил, почитал, понравилось )) В чём-то он прав.    
Просто, действительно, напишу макрос 15 строк и мне скажут «сколько заплатить тебе» и что и как мне считать сумму, если я действительно потратил 3 минуты. Не скажу же я «С вас 5000 руб.» Такую сумму никто не заплатит, это любой набросок Пикассо можно продать за огромные деньги — он уникален, а людей пишущих макросы — тысячи.  
Я беру деньги за свои макросы, в случае, когда пишу на заказ, когда это большой макрос, над которым я часами сидел писал, долго тестировал, сверялся с заказчиком и т.д. А так VBA для меня это хобби, чтобы не забыть его совсем и размять мозги.  

  Павел
Источник

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.

Источник

Like this post? Please share to your friends:
  • Vba excel копирование значения ячейки
  • Vba excel копирование диапазона ячеек с одного листа на другой
  • Vba excel копирование диапазона с листа на лист
  • Vba excel копирование данных с листа на лист
  • Vba excel копирование данных по условию