Макросы для копирования данных с одной книги в другую excel

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

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

  1. Имеется файл «Шаблон».xlm в котором данный макрос будет, если поможете;
  2. Запуск макроса, через кнопку «CommandButton.1»;
  3. После запуска макроса необходимо выбрать файл с данными.xls, там имеется один лист с названием Лист1, а также там
        имеются объединённые ячейки;
  4. Скопировать Столбцы А,В,С,D,E,F? т.е 6 шт. на Лист1;
  5. Вставить в книгу «Шаблон».xlm на лист «База», но вставка должна быть в формате Значения «123», но если так не
        получится то очистить данный лист (все удалить) перед вставкой;
  6. Если нужны файлы примера приложу;
  7. Заранее Спасибо.

Прикрепленные файлы

  • Шаблон.xlsm (14.13 КБ)
  • Данные.xls (29.5 КБ)

Изменено: Denoksa12.07.2022 22:49:22

 

New

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

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

1. да, приложите файлы
2. копируем столбцы из какой книги в какую? Из шаблона или в шаблон?

 

Denoksa

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

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

Файлы добавил Копировать из файла Данные с Лист1, в файл Шаблон на лист «База»

И еще файл с Данными может иметь разные имена, т.е. Данные1, Итоги, Смежный и т.д.

Изменено: Denoksa12.07.2022 23:02:32

 

New

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

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

#4

12.07.2022 23:24:05

Цитата
Denoksa написал:
После запуска макроса необходимо выбрать файл с данными.xls, там имеется один лист с названием Лист1, а также там     имеются объединённые ячейки;

Ай-яй-яй, как не хорошо нам врать… А с виду такие честные глаза у вас…
Скачал ваш файл «Данные.xls», открыл надеясь увидеть там лишь один лист с названием «Лист1» и что я вижу? Да, что? Что я же я там вижу? А вижу я там два листа — Лист1 и Лист2, и как вы думаете где находятся данные? Не угадали, на Лист2… Вот как после этого верить людям? Сейчас мы напишем макрос, который берёт данные с Лист1, вы его запустите у себя и…? Правильно скажите — аааа, плохой макрос, ничего не копирует!!! А мы тут будем сидеть и гадать, почему же у вас он ничего не копирует… Что делаем? Переносим таблицу с Лист2 на Лист1 и удаляем Лист2 в файле Данные?

См. файл

Код
Sub LoadData()
    Dim wbData As Workbook, sPath As String

    If MsgBox("Загрузить данные на лист База?", vbQuestion + vbYesNo, "Загрузка данных") = vbNo Then Exit Sub
    
    'очищаем данные на листе База
    With Worksheets("База")
        .Cells.Clear
    End With
    
    'запрашиваем путь к файлу
    sPath = Application.GetOpenFilename("Файлы Excel (*.xls*),*.xls*", 1, "Выберите файл с данными", , False)
    If sPath = "False" Then Exit Sub
    
    'отключаем обновление экрана
    Application.ScreenUpdating = False
    
    'открываем файл с данными
    Set wbData = Workbooks.Open(sPath, UpdateLinks:=False, ReadOnly:=True)
    
    'копируем столбцы
    wbData.Worksheets("Лист1").Columns("A:F").Copy ThisWorkbook.Worksheets("База").Range("A1")
    
    'закрываем файл с данными
    wbData.Close SaveChanges:=False
    
    'включаем обновление экрана
    Application.ScreenUpdating = True
    
    MsgBox "Данные на лист База загружены!", vbInformation, "Загрузка данных"
End Sub

Прикрепленные файлы

  • Шаблон.xlsm (20.69 КБ)

Изменено: New12.07.2022 23:44:48

 

Denoksa

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

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

Огромное спасибо, все получилось

 

юнат

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

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

#6

02.01.2023 14:54:58

С Новым годом!
А у меня не получилось.
Не могу скопировать колонку из файла V3.xlsx в колонку текущего открытого файла.
Поправьте, пожалуйста.

Код
Public Sub Primer_1()

Dim objExcelApp
Dim objWorkSheet

Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Visible = False
objExcelApp.Workbooks.Open ("C:UsersPDesktopV3.xlsx")
Set objWorkSheet = objExcelApp.ActiveWorkbook.Worksheets(1)
objExcelApp.Worksheets(1).Range("A4:A60").Copy
ThisWorkbook.Worksheets(1).Range("A4:A60").Paste
objExcelApp.Workbooks.Save ' objExcelApp.Workbooks.Saved = True
objExcelApp.Workbooks.Close
objExcelApp.Quit

End Sub
 

у меня не получилось понять  задачу, а все остальное получилось

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

 

Григорий Калюга

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

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

#8

02.01.2023 22:11:24

Цитата
юнат написал:
Поправьте, пожалуйста.

Добрый день!
Мне кажется или это так: Вы открыли файл:

Код
objExcelApp.Workbooks.Open ("C:UsersPDesktopV3.xlsx")

и эта книга стала Thisworkbook. Теперь Вы из ее листа берете данные — копируете … А где переход в текущий файл? Вероятно до открытия файла V3, Вам следовало бы в объектную переменную: dim aktivBook as Workbook: Set aktivBook = thisworkbook и после того как вы сделали .Copy, то .Paste уже в aktivBook и дальще aktivBook.Activate
Как то так. Пишу без проверки. Но идея такова.

 

Ігор Гончаренко

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

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

#9

02.01.2023 22:20:11

Цитата
Denoksa написал:
Возникла проблема пересмотрел ВСЕ.

лукавите — пересмотреть ВСЕ в инете НЕ ВОЗМЛОЖНО!!!
пока вы пересматривали ВСЕ появилась куча нового…. и вот уже не все(((
вы заметили я использовал слово «лукавите» вместо «пиз…те»)

Изменено: Ігор Гончаренко02.01.2023 22:21:59

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

 

MikeVol

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

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

Ученик

#10

03.01.2023 11:51:40

Ігор Гончаренко, кажись вас

батенька

слегка занесло. Вы написали первому ТС-у

Цитата
Ігор Гончаренко написал:
вы заметили я использовал слово «лукавите» вместо «пиз…те»)

который уже получил ответ на свой вопрос и остался довольным. А тут нарисовался другой ТС

Цитата
юнат написал:
А у меня не получилось.

Не в упрёк было сказано и уж тем более не хотел вас обидеть.
С Новым Годом! Мира и Здоровья!

Изменено: MikeVol03.01.2023 11:56:54

 

юнат

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

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

#11

03.01.2023 12:38:42

Григорий Калюга, переход для вставки в текущую открытую книгу не могу понять как выполнить,
сделал по Вашему совету ещё одну переменную:

Код
Public Sub Primer_1()

Dim objExcelApp
Dim objWorkSheet
Dim aktivbook As Workbook

Set aktivbook = ThisWorkbook
Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Visible = False
objExcelApp.Workbooks.Open ("C:UsersParkingDesktopV30.xlsx")
Set objWorkSheet = objExcelApp.ActiveWorkbook.Worksheets(1)
objExcelApp.Worksheets(1).Range("A4:A60").Copy
aktivbook.Worksheets(1).Range("A4:A60").Paste
aktivbook.Activate
objExcelApp.Workbooks.Close
objExcelApp.Quit

End Sub

но отладчику так же не нравится строка с Paste

Прикрепленные файлы

  • Paste err.jpg (111.78 КБ)

 

New

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

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

При Paste указывают только первую верхнюю левую ячейку,а не диапазон

 

MikeVol

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

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

Ученик

юнат, New говорит вам о 22-й строке

4-го поста данной темы.

Думаю так яснее станет вам.

 

юнат

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

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

New, MikeVol, пробовал, так же строчку с Paste подсвечивает

 

Hugo

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

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

#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

Visual Basic
1
2
3
4
Dim I As Integer
For I = 1 To 20
Cells(5, I).Value = Cells(10, I).Value
Next I

Но это уже совсем по-самодельному

Хотя мне это нравится больше, чем

Visual Basic
1
2
3
4
Rows("10:10").Copy
Rows("5:5").Select
    ActiveSheet.Paste
Application.CutCopyMode = False



1



nt_dmn

0 / 0 / 0

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

Сообщений: 60

05.10.2011, 18:43

 [ТС]

3

я делал очень похоже, но на строку

Visual Basic
1
ActiveSheet.Paste

ругается, в чем причина не пойму…



0



Памирыч

Почетный модератор

21371 / 9105 / 1082

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

Сообщений: 11,014

05.10.2011, 18:45

4

Visual Basic
1
Rows("5:5").Select

Это присутствует?



1



nt_dmn

0 / 0 / 0

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

Сообщений: 60

05.10.2011, 18:48

 [ТС]

5

Присутствует, а ругается потому что нечего вставлять, значит не копирует оператор

Visual Basic
1
Rows("10:10").Copy

, может перед ним тоже поставить

Visual Basic
1
Rows("10:10").Select

Добавлено через 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 минут
Вот собственно кусок кода:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
'открываем книгу
Workbooks.Open(incoming)
'копируем строку
        Rows("10:10").Select
        Rows("10:10").Copy
        'открываем сводный отчет
        Workbooks.Open (report)
        'выбираем номер начальной строки для поиска последней записи
        nss = 2
        'ищем последнюю запись
        Do While nss <> "1"
            If Range("B" & nss).Value <> "" Then
                'увеличиваем номер строки на 1
                nss = nss + 1
            Else
                'вставляем строку из буфера
                Rows("5:5").Select
                ActiveSheet.Paste
                'присваиваем переменной номера строки значение конца цикла
                nss = 1
            End If
        Loop

Для этого поста я присвоил статичную величину при вставке (5 строка), а вообще надо вставлять в строку nss.
В чем моя ошибка может быть?



0



Busine2009

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

06.10.2011, 15:43

8

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Процедура1()
'Обращаться с книгами будем через переменные
'(кода меньше писать и не промахнёшься мимо нужной книги)
Dim Исходная As Excel.Workbook, Конечная As Excel.Workbook
Dim nss As Long
Set Исходная = ActiveWorkbook
'открываем книгу
Set Конечная = Workbooks.Open("C:Documents and SettingsПользовательРабочий столКнига2.xlsx")
'копируем строку
        Исходная.Worksheets(1).Rows("10:10").Copy
        'выбираем номер начальной строки для поиска последней записи
        nss = 2
        'ищем последнюю запись
        Do While Конечная.Worksheets(1).Range("B" & nss).Value <> ""
            'увеличиваем номер строки на 1
            nss = nss + 1
        Loop
        'вставляем строку из буфера
        Конечная.Worksheets(1).Rows(nss).PasteSpecial
        Конечная.Close SaveChanges:=True
End Sub



1



0 / 0 / 0

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

Сообщений: 60

06.10.2011, 16:11

 [ТС]

9

Так работает, спасибо!

Добавлено через 24 минуты
А ещё нюансик один остался… как добиться что бы происходило копирование только значений, а формулы не копировались в новый документ?



0



Busine2009

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

06.10.2011, 16:17

10

Visual Basic
1
Конечная.Worksheets(1).Rows(nss).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

С помощью макрорекордера можно узнавать синтаксис VBA.



1



0 / 0 / 0

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

Сообщений: 60

06.10.2011, 16:48

 [ТС]

11

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

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

Цитата
Сообщение от Busine2009
Посмотреть сообщение

С помощью макрорекордера можно узнавать синтаксис VBA.

…а что такое макрорекодер?



0



Busine2009

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

06.10.2011, 17:01

12

nt_dmn,
Excel какого года у вас?



0



0 / 0 / 0

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

Сообщений: 60

06.10.2011, 17:04

 [ТС]

13

Сейчас в 2007 сижу…
А не подскажете ещё где мне отключить оповещение при закрытии файлов «в буфере обмена осталось.. бла бла бла» Чет все настройки перерыл, нету…



0



Busine2009

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

06.10.2011, 17:16

14

Цитата
Сообщение от nt_dmn
Посмотреть сообщение

…а что такое макрорекодер?

  1. Круглая кнопкаПараметры ExcelОсновныеПоказывать вкладку «Разработчик на ленте»OK;
  2. вкладка Разработчик — группа КодЗапись макроса;
  3. проделайте какие-нибудь действия (например, введите букву А и нажмите клавишу Enter);
  4. группа КодОстановить запись;
  5. в VBA будет код, который надо подкорректировать.

Цитата
Сообщение от nt_dmn
Посмотреть сообщение

А не подскажете ещё где мне отключить оповещение при закрытии файлов «в буфере обмена осталось.. бла бла бла» Чет все настройки перерыл, нету…

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

Visual Basic
1
Application.DisplayAlerts = False

а эту после закрытия книги:

Visual Basic
1
Application.DisplayAlerts = True



1



0 / 0 / 0

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

Сообщений: 60

06.10.2011, 17:32

 [ТС]

15

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



0



gera_vip

0 / 0 / 0

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

Сообщений: 5

13.06.2014, 15:35

16

Форумчане, подскажите, пожалуйста, как в 12 строчке кода, вместо Rows(«10:10») указать копировать заполненный диапазон, начиная от второй строчки и до конца, где есть записи.
И есть ли возможность, этот макрос привязать к какой-то новой кнопке на ленте? А то с этим еще не разбирался.
Заранее спасибо!

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Процедура1()
'Обращаться с книгами будем через переменные
'(кода меньше писать и не промахнёшься мимо нужной книги)
Dim Исходная As Excel.Workbook, Конечная As Excel.Workbook
Dim nss As Long
Set Исходная = ActiveWorkbook
'открываем книгу
Set Конечная = Workbooks.Open("C:Documents and SettingsПользовательРабочий столКнига2.xlsx")
'копируем строку 
'Вот тут :)
Исходная.Worksheets(1).Rows("10:10").Copy
        'выбираем номер начальной строки для поиска последней записи
        nss = 2
        'ищем последнюю запись
        Do While Конечная.Worksheets(1).Range("B" & nss).Value <> ""
            'увеличиваем номер строки на 1
            nss = nss + 1
        Loop
        'вставляем строку из буфера
        Конечная.Worksheets(1).Rows(nss).PasteSpecial
        Конечная.Close SaveChanges:=True
End Sub



0



Hugo121

6875 / 2807 / 533

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

Сообщений: 8,562

13.06.2014, 16:09

17

Попробуйте так (не проверял):

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
Sub Процедура1()
'Обращаться с книгами будем через переменные
'(кода меньше писать и не промахнёшься мимо нужной книги)
    Dim Исходная As Excel.Workbook, Конечная As Excel.Workbook
    Set Исходная = ActiveWorkbook
    'открываем книгу
    Set Конечная = Workbooks.Open("C:Documents and SettingsПользовательРабочий столКнига2.xlsx")
    'копируем строку
    'Вот тут :)
    Исходная.Worksheets(1).Range("B2").CurrentRegion.Copy Конечная.Worksheets(1).Cells(Rows.Count, "B").End(xlUp)(2, 0)
    Конечная.Close SaveChanges:=True
End Sub



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

Visual Basic
1
    Исходная.Worksheets(1).Range("B2").CurrentRegion.Offset(1).Copy Конечная.Worksheets(1).Cells(Rows.Count, "B").End(xlUp)(2, 0)

Будет правда ещё снизу одну пустую строку прихватывать — но это ведь ерунда. Можно убрать ресайсом, но лень.



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.

cf5e0ebf6d62c9ec73df03c55f727e77.jpg

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?

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
  • Макросы для microsoft excel скачать
  • Макросы для защиты excel
  • Макросы для excel яндекс
  • Макросы для excel штрих код