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

Ну, чтобы скопировать лист многого не надо, если формулы ссылаются на листы, имена которых имеются в книге, в которую вы копируете, то и при вставке листа они будут ссылаться на листы, но уже в новой книге.
По поводу макроса, чтобы ссылался на новую книгу, то у вас скорее всего макрос написан в модуле, а вы копируете лист. Модуль-то у вас остался в старой книге. Соответственно и макрос с кнопки ссылается на модуль в той книге, а не в скопированной.
Если вы хотите перенести лист с макросом, тогда напишите макрос в листе, а не в модуле, например

Код
Sub МакросМой() MsgBox ThisWorkbook.Name [CODE]End Sub

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

Код
Sub МакросКопирования() Dim K_Out As Workbook Dim K_Input As Workbook Set K_Out = Workbooks("Книга2.xlsm") Set K_Input = Workbooks("Книга1.xlsm") K_Out.Sheets(1).Copy before:=K_Input.Sheets(1) With K_Input .Sheets(1).Shapes(1).OnAction = .Name & "!" & .Sheets(1).CodeName & "." & "МакросМой" End With End Sub

Код

Sub МакросКопирования()
Dim K_Out As Workbook
Dim K_Input As Workbook
Set K_Out = Workbooks("Книга2.xlsm")
Set K_Input = Workbooks("Книга1.xlsm")

K_Out.Sheets(1).Copy before:=K_Input.Sheets(1)
With K_Input
    .Sheets(1).Shapes(1).OnAction = .Name & "!" & .Sheets(1).CodeName & "." & "МакросМой"
End With
End Sub

В этом макросе копируется из книги 2 в книгу 1 лист 1. >> Вставляется перед первым листом в копируемой книге, то-бишь становится первым. >> Далее на первый лист, который мы вставили, переназначаем макрос, который находится в скопированном листе.

Источник

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

Источник

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.

Источник

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

Sub Название_Макроса()

'Выделить диапазон который необходимо скопировать
Range("A1:F52").Select
'Скопировать то, что выделено
Selection.Copy
ChDir "путь к папке где лежит файл в который необходимо скопировать"
Workbooks.Open Filename:= "Название файла, который находится в папке, путь к которой указан выше"
'Выделить начальную ячейку в которую необходимо вставить скопированные данные
Range("A6").Select
'Вставить данные
ActiveSheet.Paste
'сохранить текущую книгу
ActiveWorkbook.Save
'Закрыть книгу
ActiveWorkbook.Close
End Sub

Вариант 2: В открывшейся книге запускаем макрос, чтобы он открыл нужную нам книгу, скопировал от туда нужные нам данные и вставил в нашу открытую книгу, закрыв файл из которого эти данные были скопированы

Sub Название_Макроса2()
'Открываем файл с которого нужно скопировать данные
Workbooks.Open Filename:="C:Данные.xlsx"

'Скопировать нужный диапазон в открывшейся книге на листе 1
Workbooks("Данные.xlsx").Worksheets("Лист1").Range("A16:E16").Copy
'Активируем нужную нам книгу
Workbooks("Книга1.xlsm").Activate

'Выделяем и вставляем скопированные данные в ячейку А1
ActiveWorkbook.Worksheets("Лист1").Range("A1").Select
ActiveSheet.Paste

'Закрываем книгу откуда мы скопировали данные
Workbooks("Данные.xlsx").Close

End Sub

Еще пример — Скопировать диапазоны данных из активной открытой книги Excel нескольких листов (в нашем примере 3-х листов) в другую книгу, которая хранится в определенном месте. Данные будут вставлены как значения, плюс будут перенесены форматы ячеек.

Sub Копируем_листы_в_другую_книгу()
Dim bookconst As Workbook
Dim abook As Workbook
Set abook = ActiveWorkbook 'присваиваем перменную активной книге
Set bookconst = Workbooks.Open("C:UsersUserDesktop1.xlsx") 'присваиваем перменную книге куда необходимо копировать данные

'переходим в активную книгу откуда необходимо скопировать данные
abook.Worksheets("Лист1").Activate
Range("A1:I23").Copy 'копируем определенный диапазон листа, укажите свой диапазон
bookconst.Worksheets("Лист1").Activate 'активируем лист куда необходимо вставить данные
Range("A1:I23").Select 'встаем на ячейку А1
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'вставляем только форматы ячеек
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'второй лист
abook.Worksheets("Лист2").Activate
Range("A1:I23").Copy
bookconst.Worksheets("Лист2").Activate
Range("A1:I23").Select 'выделяем диапазон
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'вставляем только форматы ячеек
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'третий лист
abook.Worksheets("Лист3").Activate
Range("A1:I23").Copy
bookconst.Worksheets("Лист3").Activate
Range("A1:I23").Select 'выделяем диапазон
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'вставляем только форматы ячеек
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'сохранить текущую книгу
bookconst.Save
'Закрыть книгу
bookconst.Close
abook.Activate

End Sub

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

Спасибо за внимание.

Источник

0 / 0 / 0

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

Сообщений: 27

Excel

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

31.07.2019, 16:19. Показов 12982. Ответов 24

Всем доброго дня!
Помогите пожалуйста написать код, сам не могу написать по причине отсутствия знаний.
Есть книга с именем «Заказы на производства». В ней имеются 3 листа, в каждом листе формируется бланк-заказа на то или иное производство.
Нужен код который копирует данные (значения и формат таблиц) с активного листа (без кода в модуле листа), и вставляет эти данные во вновь созданную книгу. Причем имя у книги соответствует имени листа из которого копировали данные. Новую книгу закрывать не нужно.

Наверное слишком запутанно все описал.
Очень надеюсь на помощь.

~~Остап Бонд~~

Заблокирован

31.07.2019, 17:15

Ivanov_Sergey, примерно так —

Visual Basic

sub AAAAAAAAAAAA
n=activesheet.name
activesheet.copy
activeworkbook.saveas n & ".xlsb"
end sub

0 / 0 / 0

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

Сообщений: 27

31.07.2019, 17:23

[ТС]

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

Надеюсь есть решение…
Спасибо

~~Остап Бонд~~

Заблокирован

31.07.2019, 17:37

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

Visual Basic

Sub AAAAAAAAAAAA()
n = ActiveSheet.Name
ActiveSheet.Copy
ActiveWorkbook.SaveAs n & ".xlsx", xlWorkbookNormal
End Sub

0 / 0 / 0

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

Сообщений: 27

31.07.2019, 18:00

[ТС]

Остап, мне очень жаль что я достаю своими глупыми пожеланиями и вопросами.
Но к сожалению, и данный вариант не привел к положительному результату.
Код с копировался вместе с данными.
А можно просто методом выделения диапазона, скопировать все в новую книгу?

Спасибо.

Добавлено через 10 минут

Наверное слишком запутанно все описал.
Очень надеюсь на помощь.

Burk, приветствую! Может быть Вы сможете помочь в решении?!

pashulka

4131 / 2235 / 940

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

Сообщений: 4,624

31.07.2019, 18:33

Ivanov_Sergey, Вы зря отказываетесь от идеи Остапа

Visual Basic

Private Sub Test()
    Application.DisplayAlerts = False
    ActiveSheet.Copy
    With ActiveWorkbook
         .SaveAs .ActiveSheet.Name & ".xlsx", xlOpenXMLWorkbook
         .Close False
    End With
    Application.DisplayAlerts = True
End Sub

Burk

1813 / 1135 / 346

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

Сообщений: 4,002

31.07.2019, 18:35

Ivanov_Sergey, считаем, что открыты исходная номер 1 и новая Книга под номером 2. Тогда должно сработать так (копируем только значения

Visual Basic

Sub ValueOnly()
'
    Workbooks(1).Activate
    n = ActiveWorkbook.Name
    Cells.Select: Selection.Copy
    Workbooks(2).Activate
    [A1].Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
ActiveWorkbook.SaveAs n & ".xlsx", xlWorkbookNormal
End Sub

Кстати, я вам ведь писал про макререкодер, почему бы вам не попытаться сделать при его поиощи ,

4131 / 2235 / 940

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

Сообщений: 4,624

31.07.2019, 18:35

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

Новую книгу закрывать не нужно.

Пока её не закроете, в модуле листа будут жить макросы. Потом исчезнут, ибо в файлах «.xlsx» они не живут.

Ivanov_Sergey

0 / 0 / 0

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

Сообщений: 27

31.07.2019, 18:39

[ТС]

Pashulka, Burk приветствую вас!
Я даже не проверяя код)) уверен что все сработает))
Я тут старался, пробовал сам сделать, вот что вышло. Работает!

Visual Basic

Sub VigruzkaZakaza()
 
Application.ScreenUpdating = False
 Dim New_Wb As Workbook
    Set New_Wb = Workbooks.Add
    New_Wb.Activate
    New_Wb.SaveAs ("D:" & ThisWorkbook.ActiveSheet.Range("A1") & ".xls")
    'New_Wb.Close
    
'êîïèðóþ äàííûå ñ ëèñòà
    Workbooks("Çàêàçû-ïðîèçâîäñòâà.xlsm").Activate
    ActiveSheet.Cells.Copy
    'Cells.Select
'Selection.Copy
  Workbooks("Áëàíê-Çàêàç.xls").Activate
    Cells.Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
Application.ScreenUpdating = True
        
End Sub

Добавлено через 48 секунд
что это? Комментарии как то странно отобразились((

0 / 0 / 0

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

Сообщений: 27

31.07.2019, 18:43

[ТС]

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

Миниатюры

0 / 0 / 0

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

Сообщений: 27

31.07.2019, 18:50

[ТС]

Burk, вот сделал код с его помощью

Кстати, я вам ведь писал про макререкодер, почему бы вам не попытаться сделать при его поиощи

Добавлено через 4 минуты

Пока её не закроете, в модуле листа будут жить макросы. Потом исчезнут, ибо в файлах «.xlsx» они не живут.

Попробовал код запустить, но опять вылетела ошибка. Файл (новая книга) не закрылась

Burk

1813 / 1135 / 346

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

Сообщений: 4,002

31.07.2019, 18:57

Ivanov_Sergey, 4 строка неправильно записана, надо так

Visual Basic

1	n = ActiveWorkbook.Sheets(1).Name

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

4131 / 2235 / 940

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

Сообщений: 4,624

31.07.2019, 19:02

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

Попробовал код запустить, но опять вылетела ошибка. Файл (новая книга) не закрылась

Почему опять ? Раньше Вы про ошибку не говорили. Впрочем, папку для сохранения лучше указать явно, но даже сейчас — ошибки быть не должно.

Ivanov_Sergey

0 / 0 / 0

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

Сообщений: 27

31.07.2019, 19:03

[ТС]

Burk, огромное спасибо. А Вы можете в мой код вживить свой код.

Visual Basic

Sub VigruzkaZakaza()
 
    Application.ScreenUpdating = False
    Dim New_Wb As Workbook
    Set New_Wb = Workbooks.Add
    New_Wb.Activate
    New_Wb.SaveAs ("D:" & ThisWorkbook.ActiveSheet.Range("A1") & ".xls")
    
'   копирую данные с листа
 
    Workbooks("Заказы-производства.xlsm").Activate
    ActiveSheet.Cells.Copy
    Workbooks("Бланк-Заказ.xls").Activate
    Cells.Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
        
End Sub

Добавлено через 1 минуту
предположим что у меня открыта только одна книга — «Заказы-производства.xlsm»

1813 / 1135 / 346

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

Сообщений: 4,002

31.07.2019, 19:15

Ivanov_Sergey, так что у вас в «Заказы-производства.xlsm» в ячейке А1 находится имя будущего файла???
Вроде речь шла о имя нового файла = имя листа в старом

Ivanov_Sergey

0 / 0 / 0

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

Сообщений: 27

31.07.2019, 19:22

[ТС]

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

Visual Basic

1	n=ActiveWorkSheet.Name

Добавлено через 2 минуты
Что то я делаю не так(((

Visual Basic

Sub VigruzkaZakaza()
 
    Application.ScreenUpdating = False
    Dim New_Wb As Workbook
    Set New_Wb = Workbooks.Add
    New_Wb.Activate
    n = ActiveWorksheets.Name
    New_Wb.SaveAs ("D:" & n & ".xls")
    
'   копирую данные с листа
 
    Workbooks("Заказы-производства.xlsm").Activate
    
    Cells.Select: Selection.Copy
    Workbooks("Бланк-Заказ.xls").Activate
    [a1].Select
'   ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWorkbook.SaveAs n & ".xlsx", xlWorkbookNormal
 
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
        
End Sub

Burk

1813 / 1135 / 346

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

Сообщений: 4,002

31.07.2019, 19:48

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

Решение

Если не нужно убирать возможные формулы на листе, то можно так, только разберитесь в именем новой книги, эта строка сейчас закомментирована. Если формулы листа не нужны, то раскомментировать две строки с PasteSpecial

Visual Basic

Sub VigruzkaZakaza()
 
    Application.ScreenUpdating = False
    Dim New_Wb As Workbook
    Set New_Wb = Workbooks.Add
 '   копирую данные с листа
    Workbooks("Заказы-производства.xlsm").Activate
    n = ActiveWorkbook.Sheets(1).Name
    ActiveSheet.Cells.Copy
    New_Wb.Activate
    [A1].Select: ActiveSheet.Paste
    Application.CutCopyMode = False
'    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
'        :=False, Transpose:=False
 
'    New_Wb.SaveAs ("D:" & ThisWorkbook.ActiveSheet.Range("A1") & ".xls")
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
        
End Sub

это для загруженного основного файла

0 / 0 / 0

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

Сообщений: 27

31.07.2019, 19:56

[ТС]

Попробовал снять галочки с этих строк:

‘ Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
‘ :=False, Transpose:=False

Выдает ошибку (см. скрин)

Миниатюры

0 / 0 / 0

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

Сообщений: 27

31.07.2019, 19:58

[ТС]

Burk. Название файла делаем как название листа, из которого копируем

1813 / 1135 / 346

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

Сообщений: 4,002

31.07.2019, 20:01

строку 12 уберите, пропустил

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

Источник