Задача состоит в том, чтобы скопировать определенный диапазон текущего листа, открыть другую книгу, и вставить эти скопированные данные в определенную ячейку, сохранить этот файл и закрыть. Ниже приведен код 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
Если статья была вам полезна, то буду благодарен, если вы поделитесь ей со своими друзьями с помощью кнопок расположенных ниже.
Спасибо за внимание.
Denoksa Пользователь Сообщений: 16 |
Добрый вечер. Прощу помощи. Возникла проблема пересмотрел ВСЕ. Суть вопроса нужен макрос для копирования данных из одной книги в другую, а именно:
Прикрепленные файлы
Изменено: Denoksa — 12.07.2022 22:49:22 |
New Пользователь Сообщений: 4582 |
1. да, приложите файлы |
Denoksa Пользователь Сообщений: 16 |
Файлы добавил Копировать из файла Данные с Лист1, в файл Шаблон на лист «База» И еще файл с Данными может иметь разные имена, т.е. Данные1, Итоги, Смежный и т.д. Изменено: Denoksa — 12.07.2022 23:02:32 |
New Пользователь Сообщений: 4582 |
#4 12.07.2022 23:24:05
Ай-яй-яй, как не хорошо нам врать… А с виду такие честные глаза у вас… См. файл
Прикрепленные файлы
Изменено: New — 12.07.2022 23:44:48 |
||||
Denoksa Пользователь Сообщений: 16 |
Огромное спасибо, все получилось |
юнат Пользователь Сообщений: 22 |
#6 02.01.2023 14:54:58 С Новым годом!
|
||
у меня не получилось понять задачу, а все остальное получилось Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете! |
|
Григорий Калюга Пользователь Сообщений: 153 |
#8 02.01.2023 22:11:24
Добрый день!
и эта книга стала Thisworkbook. Теперь Вы из ее листа берете данные — копируете … А где переход в текущий файл? Вероятно до открытия файла V3, Вам следовало бы в объектную переменную: dim aktivBook as Workbook: Set aktivBook = thisworkbook и после того как вы сделали .Copy, то .Paste уже в aktivBook и дальще aktivBook.Activate |
||||
Ігор Гончаренко Пользователь Сообщений: 13746 |
#9 02.01.2023 22:20:11
лукавите — пересмотреть ВСЕ в инете НЕ ВОЗМЛОЖНО!!! Изменено: Ігор Гончаренко — 02.01.2023 22:21:59 Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете! |
||
MikeVol Пользователь Сообщений: 230 Ученик |
#10 03.01.2023 11:51:40 Ігор Гончаренко, кажись вас
слегка занесло. Вы написали первому ТС-у
который уже получил ответ на свой вопрос и остался довольным. А тут нарисовался другой ТС
Не в упрёк было сказано и уж тем более не хотел вас обидеть. Изменено: MikeVol — 03.01.2023 11:56:54 |
||||
юнат Пользователь Сообщений: 22 |
#11 03.01.2023 12:38:42 Григорий Калюга, переход для вставки в текущую открытую книгу не могу понять как выполнить,
но отладчику так же не нравится строка с Paste Прикрепленные файлы
|
||
New Пользователь Сообщений: 4582 |
При Paste указывают только первую верхнюю левую ячейку,а не диапазон |
MikeVol Пользователь Сообщений: 230 Ученик |
юнат, New говорит вам о 22-й строке 4-го поста данной темы. Думаю так яснее станет вам. |
юнат Пользователь Сообщений: 22 |
New, MikeVol, пробовал, так же строчку с Paste подсвечивает |
Hugo Пользователь Сообщений: 23253 |
#15 03.01.2023 20:51:10 юнат, между приложениями ранее копировать диапазоны было нельзя. Может теперь что изменилось, не знаю, не проверял. |
0 / 0 / 0 Регистрация: 28.04.2011 Сообщений: 60 |
|
1 |
|
Копирование строки из одной книги в другую05.10.2011, 17:50. Показов 52429. Ответов 19
Необходимо скопировать строку под номером 10 с активного листа активной книги, открыть книгу например С:test.xls (с одним листом) и вставить скопированные данные в 5 строку.
0 |
Памирыч Почетный модератор 21371 / 9105 / 1082 Регистрация: 11.04.2010 Сообщений: 11,014 |
||||||||
05.10.2011, 18:38 |
2 |
|||||||
Но это уже совсем по-самодельному Хотя мне это нравится больше, чем
1 |
nt_dmn 0 / 0 / 0 Регистрация: 28.04.2011 Сообщений: 60 |
||||
05.10.2011, 18:43 [ТС] |
3 |
|||
я делал очень похоже, но на строку
ругается, в чем причина не пойму…
0 |
Памирыч Почетный модератор 21371 / 9105 / 1082 Регистрация: 11.04.2010 Сообщений: 11,014 |
||||
05.10.2011, 18:45 |
4 |
|||
Это присутствует?
1 |
nt_dmn 0 / 0 / 0 Регистрация: 28.04.2011 Сообщений: 60 |
||||||||
05.10.2011, 18:48 [ТС] |
5 |
|||||||
Присутствует, а ругается потому что нечего вставлять, значит не копирует оператор
, может перед ним тоже поставить
Добавлено через 1 минуту
0 |
Почетный модератор 21371 / 9105 / 1082 Регистрация: 11.04.2010 Сообщений: 11,014 |
|
05.10.2011, 18:51 |
6 |
Прикрепил книгу
2 |
nt_dmn 0 / 0 / 0 Регистрация: 28.04.2011 Сообщений: 60 |
||||
06.10.2011, 10:23 [ТС] |
7 |
|||
В книге вижу что работает, а у меня почему то нет, ладно… утро вечера мудренее Добавлено через 15 часов 18 минут
Для этого поста я присвоил статичную величину при вставке (5 строка), а вообще надо вставлять в строку nss.
0 |
Заблокирован |
||||
06.10.2011, 15:43 |
8 |
|||
1 |
0 / 0 / 0 Регистрация: 28.04.2011 Сообщений: 60 |
|
06.10.2011, 16:11 [ТС] |
9 |
Так работает, спасибо! Добавлено через 24 минуты
0 |
Заблокирован |
||||
06.10.2011, 16:17 |
10 |
|||
С помощью макрорекордера можно узнавать синтаксис VBA.
1 |
0 / 0 / 0 Регистрация: 28.04.2011 Сообщений: 60 |
|
06.10.2011, 16:48 [ТС] |
11 |
Спасибо огромное, я просто не спец, сижу разбираюсь, второй день как с vba связался Добавлено через 23 минуты
С помощью макрорекордера можно узнавать синтаксис VBA. …а что такое макрорекодер?
0 |
Заблокирован |
|
06.10.2011, 17:01 |
12 |
nt_dmn,
0 |
0 / 0 / 0 Регистрация: 28.04.2011 Сообщений: 60 |
|
06.10.2011, 17:04 [ТС] |
13 |
Сейчас в 2007 сижу…
0 |
Заблокирован |
||||||||
06.10.2011, 17:16 |
14 |
|||||||
…а что такое макрорекодер?
А не подскажете ещё где мне отключить оповещение при закрытии файлов «в буфере обмена осталось.. бла бла бла» Чет все настройки перерыл, нету… не знаю, можно это сделать с помощью интерфейса программы Excel, а программно вот так делается:
а эту после закрытия книги:
1 |
0 / 0 / 0 Регистрация: 28.04.2011 Сообщений: 60 |
|
06.10.2011, 17:32 [ТС] |
15 |
Спасибо, со всем разобрался
0 |
gera_vip 0 / 0 / 0 Регистрация: 13.06.2014 Сообщений: 5 |
||||
13.06.2014, 15:35 |
16 |
|||
Форумчане, подскажите, пожалуйста, как в 12 строчке кода, вместо Rows(«10:10») указать копировать заполненный диапазон, начиная от второй строчки и до конца, где есть записи.
0 |
Hugo121 6875 / 2807 / 533 Регистрация: 19.10.2012 Сообщений: 8,562 |
||||
13.06.2014, 16:09 |
17 |
|||
Попробуйте так (не проверял):
1 |
0 / 0 / 0 Регистрация: 13.06.2014 Сообщений: 5 |
|
13.06.2014, 16:19 |
18 |
Hugo, а что поменять, чтобы копировались не все данные, а начиная со второй строки и до конца, т.к. в первой строке идут названия столбцов?
0 |
Hugo121 6875 / 2807 / 533 Регистрация: 19.10.2012 Сообщений: 8,562 |
||||
13.06.2014, 16:50 |
19 |
|||
Будет правда ещё снизу одну пустую строку прихватывать — но это ведь ерунда. Можно убрать ресайсом, но лень.
1 |
0 / 0 / 0 Регистрация: 13.06.2014 Сообщений: 5 |
|
13.06.2014, 18:16 |
20 |
Hugo, огромнейшая благодарность!!! Работает!
0 |
How to copy and paste data using a Macro in Excel. I’ll show you multiple ways to do this, including across worksheets and workbooks.
Sections:
Simple Copy/Paste
Copy Entire Range
Copy between Worksheets
Copy between Workbooks
Notes
Simple Copy/Paste
Range("A1").Copy Range("B1")
This copies cell A1 to cell B1.
Range(«A1»).Copy is the part that copies the cell.
Range(«B1») is the cell where the data will be copied.
This is a simple one line piece of code and it’s very easy to use.
Notice that there is a space between these two parts of the code.
Copy Entire Range
Range("A1:A5").Copy Range("B1:B5")
Range(«A1:A5»).Copy is the part that copies the range.
Range(«B1:B5») is the range where the data will be copied.
You can also write it like this:
Range("A1:A5").Copy Range("B1")
Notice that the range to where you will copy the data has only a reference to cell B1.
You only have to reference the very first cell to which the range will be copied and the entire range will copy in the cells below there.
NOTE: if you do it like this, you may end up overwriting data and Excel will not give you a warning about this; the data will simply be filled down as far as it needs to go to copy the first range.
Copy between Worksheets
Sheets("Sheet1").Range("A1").Copy Sheets("Sheet2").Range("B1")
This follows the same pattern as the above examples except that we need to tell the macro from which sheet we want to get the data and to which sheet we want to copy the data.
Sheets(«Sheet1»). is placed in front of the first range and that means to get the data from Sheet1, which is the name of a worksheet in the workbook.
Sheets(«Sheet2»). is placed in front of the range to which we want to copy the data and Sheet2 is the name of the worksheet where the data will be copied.
Copy between Workbooks
Workbooks("Copy and Paste Data using Macro VBA in Excel.xlsm").Sheets("Sheet1").Range("A1").Copy Workbooks("Copy and Paste Data using Macro VBA in Excel.xlsm").Sheets("Sheet3").Range("A1")
Here, we follow the above examples and, this time, add a reference to the workbooks from which we want to get the data and to which we want to place the data.
Workbooks(«Copy and Paste Data using Macro VBA in Excel.xlsm»). is the code that says in which workbook we want to place the data. Copy and Paste Data using Macro VBA in Excel.xlsm is the name of the workbook. In this example I used this for both parts, the workbook from which the data comes and where it goes. This allows you to run this macro within a single workbook and still show you how it works. In a real-world example, the first part contains the name of the workbook where you get the data from and the second contains the name of the workbook where you want to place the data.
Read this tutorial to copy values from another workbook, even if it’s closed.
Notes
All examples in the attached workbook have been commented out. Simply remove the single quote from the line of code you want to test and then run the macro.
Download the attached file to get these examples in Excel.
Similar Content on TeachExcel
Activate or Navigate to a Worksheet using Macros VBA in Excel
Tutorial: Make a particular worksheet visible using a macro in Excel.
This is called activating a wo…
Get the Name of a Worksheet in Macros VBA in Excel
Tutorial: How to get the name of a worksheet in Excel using VBA and Macros and also how to store tha…
Get the Last Row using VBA in Excel
Tutorial:
(file used in the video above)
How to find the last row of data using a Macro/VBA in Exce…
Remove Dashed Lines from Copy Paste VBA in Excel
Tutorial: How to remove the flashing dashes from a copy/paste range using VBA in Excel; this removes…
Copy one range and paste in another range
Tutorial: Below is a macro, just copy and paste it into a module in your workbook and go from there…
Guide to Combine and Consolidate Data in Excel
Tutorial: Guide to combining and consolidating data in Excel. This includes consolidating data from …
Subscribe for Weekly Tutorials
BONUS: subscribe now to download our Top Tutorials Ebook!
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
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
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.
answered Jul 28, 2011 at 19:05
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
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
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