Как с помощью VBA скопировать данные из одной книги в другую

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

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

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

Поделиться:
45 Комментариев
  • Сабина:

    ДД!

    спасибо большое за Ваш пост! Нужно было переносить строки из общей таблицы на разные листы другой книги.

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

    То, что я имею сейчас:

    Sub Перенос_строк_состав_комм_КМ()

    Workbooks.Open Filename:=C:\1\2.xlsx"

    Workbooks («2.xlsx»).Worksheets («приложение 3»).Range («F30:BC30»).Copy

    Workbooks («КФ.xlsm»).Activate

    ActiveWorkbook.Worksheets («составление комм КМ»).Range («C5»).Select

    ActiveSheet.Paste

    Workbooks («2.xlsx»).Close

    End Sub

  • Мария:

    вложение  .вариант.xls

    Добрый день. Ваш код мне очень подходит. Вопрос, как изменить диапазон ячеек в коде, при условии, что я хочу перенести в другую книгу в определенный лист несколько разных ячеек с одного листа НАПРИМЕР диапазоны B7:С24 и H7:I24 . Подскажите как правильно это нужно указать. Спасибо.

    • excel:

      Решили вопрос? Вам нужно скопировать сначала один диапазон, потом снова выделить книгу откуда вы копируете, например так

      Workbooks («Книга1.xlsm»).Activate

      снова повторить копирование уже другого диапазона

      • Мария:

        вложение  .вариант-1.xls

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

        abook.Worksheets («3»).Activate

        Range («B7:C39», «H7:I39»).Copy

        bookconst.Worksheets («3»).Activate

        Range («B7»).Select 'выделяем диапазон

        а копирует он только диапазон «H7:I39», игнорируя диапазон B7:C39

        Так я и не решила эту проблему...

        • Юрий:

          На мой взгляд у вас проблема о объединенных ячейках. У вас 61 и другие строки объединены. Вы попробуйте вручную выделить диапазон B7:C39 — у вас не получится и у VBA тоже не получается

        • Алексей:

          Нужно делать по-отдельности. Сначала одни диапазон, потом второй и так далее

          abook.Worksheets («3»).Activate

          Range («B7:C39»).Copy

          bookconst.Worksheets («3»).Activate

          Range («B7»).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 («H7:I39»).Copy

          ...

          • Мария:

            Эти Варианты я все перепробовала, решение оказалось таким:

            Range («B9:C2900, D9:E2900, K9:L2900»).Copy

            bookconst.Worksheets («благ»).Activate

            Range («B4»).Select 'встаем на ячейку А1

            При этом в заданных диапазонах не должны быть пересечения объеденных ячеек.

            СПАСИБО АВТОРУ

  • Дмитрий:

    Добрый день,

    В коде при варианте 1 выводит ошибку 1004, выделяя желтым строку кода:

    Range («A6»).Select

    Подскажите, плиз, как подправить...

    • excel:

      В этой строке вряд ли ошибка может быть. Проверил код, должно все работать

      Единственное вот тут неправильное описание

      Workbooks.Open Filename:= «путь к файлу»

      здесь нужно указать не путь к файлу, а только название файла, путь к папке мы указали в чуть выше в коде

      • Дмитрий:

        Вопрос не актуален, спасибо!

        Решение найдено!

        • excel:

          Отлично, в чем была причина?

          • Дмитрий:

            Также, вот чуток модифицированный вариант для того, чтобы данные не перезаписывались, а вставлялись в новую строку:

            Sub Macros1 ()

            Range («A1:E1»).Select

            Selection.Copy

            ChDir «C:\Users\50545\Desktop»

            Workbooks.Open Filename:="123.xlsx"

            ActiveSheet.Range («A1»).Select

            If ActiveSheet.Range («A1»).Value = "" Then

            ActiveSheet.Paste

            ActiveWorkbook.Save

            ActiveWorkbook.Close

            Else

            Cells (Rows.Count, 1).End (xlUp).Offset (1, 0).Select

            ActiveSheet.Paste

            ActiveWorkbook.Save

            ActiveWorkbook.Close

            End If

            End Sub

          • Дмитрий:

            Создал отдельный модуль для макроса (до этого был в модуле листа)...

      • Дмитрий:

        вложение  Book123.zip

        ну и сам файл...

      • Дмитрий:

        вложение Untitled

        Добрый день,

        К сожалению, ошибку все еще выдает 🙁

        Прикладываю сам файл и принт-скрин...

        Буду признателен за помощь в исправлении...

  • User:

    вложение  .xls

    И вот ещё фаил, в дополнение к первому сообщению. Сразу два не смог отправить.

  • User:

    вложение  .xls

    Доброго времени суток.

    Подскажите пожалуйста код макроса со следующим функционалом:

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

    На словах макрос я бы описал так:

    Открываем документ «База» вкладка «Лист1» копируем значение ячейки С15, после чего вставляем её в документ «Отчёт» вкладка «Данные» в поле F19.

    Далее

    Открываем документ «База» вкладка «Лист1» копируем значение ячейки С18, после чего вставляем её в документ «Отчёт» вкладка «Данные» в поле D20.

    Далее

    Открываем документ «База» вкладка «Лист1» копируем значение ячейки С24, после чего вставляем её в документ «Отчёт» вкладка «Данные» в поле L3.

    И так далее...

    Да, необходимо копировать только значение (стиль и т.д. не нужно) И если например в базе какая то ячейка стала пустой, то на пустоту необходимо заменить значение, что было прописано ранее в остальных документах.

    В программировании не силён, если можно с кратким объяснением.

    Пример приложил. Значения цифровые и текстовые, могут быть одновременно. Должны быть скопированы в неизменном виде (как в примере). Поля Параметр 2, Параметр 3 и т.д. роли не играют. Этим я просто показал что ячейки могут находиться в разных местах.

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

  • Slava:

    Добрый вечер. Это опять я.

    Появилась новая задача. Есть файл источник в котором есть данные.

    Тот макрос, который Вы помогли запустить копирует только из этого, определенного файла.

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

    То есть я копирую макрос в другой файл, а он сохраняет в отдельный.

    Спасибо.

  • slava:

    нет. все равно заменяет.

    может Вы можете помочь немного по другому.

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

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

    Sub Кнопка2 Щелчок()

    '

    ' Кнопка2_Щелчок Макрос

    '

    ' Сочетание клавиш: Ctrl+j

    '

    Range («A7:J7»).Select

    Selection.Copy

    Workbooks.Open Filename:="C:\Users\Slava\Desktop\Neuer Ordner\1.xlsm"

    Range («A1:J1»).Select

    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _

    SkipBlanks:=False, Transpose:=False

    ActiveSheet.Paste

    Application.CutCopyMode = False

    ActiveWorkbook.Save

    ActiveWindow.Close

    End Sub

    может быть так проще?

    • excel:

      Нет, не проще. Проверьте еще раз внимательно. У меня все работает. Данные не заменяются, а вставляются в следующие строку.

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

      • Slava:

        Добрый вечер. Хочу Вас поблагодарить. Все получилось.

        Только я методом «тыка» изменил немного код. А именно вот эту строку

        iLastRow = Workbooks («Книга1.xlsm»).Worksheets («Лист1»).Range («F5000»).End (xlUp).Row + 1

        у Вас стоял («Книга1.xlsm») а я написал («1.xlsm») указал ту книгу в которую производить копирование и всё пошло нормально.

        Еще раз спасибо.

        • excel:

          Да, все верно. Я просто тестировал на своих файлах и забыл поменять. Удачи!

          • Slava:

            спасибо. и Вам тоже Удачи!

  • slava:

    вот так все выглядит

    clip2net.com/s/j68yRt

    • excel:

      Это понятно. Все это находится в Книга1.xlsm? и необходимые данные для копирования находятся на листе 1 и вы выделяете эти данные и потом запускаете макрос?

      У вас макрос привязан к активной ячейки на момент запуска макроса

      • slava:

        да. все правильно.

        Ставлю курсор в G7 — Книга1.xlsm, а потом нажимаю кнопку. файл 1.xlsm открывается и в него копируются нужные ячейки. после закрывается.

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

        Я бы мог вообще уйти от макроса, который я прислал. просто он работает, когда все в одном файле.

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

        • excel:

          Тут видимо дело все таки в строчке, где ищется нужная последняя строка iLastRow

          Попробуйте так прописать:

          iLastRow = Workbooks("Книга1.xlsm").Worksheets("Лист1").Range("G5000").End(xlUp).Row + 1

          G5000 я взял просто с запасом. У вас не должно быть данных больше, чем на 5000 строк, если больше, то число нужно взять больше, Столбец G — этот тот столбец, где указаны данные от которых нужно отступить одну строчку после вставки данных.

  • Slava:

    Excel. Спасибо за поддержку.

    ругается вот на эту строчку. Цвет желтый.

    Workbooks («Книга1.xlsm»).Activate

    • excel:

      Ругаться не должен. У вас файл, где лежат данные (откуда копировать) должен называться Книга1.xlsm либо меняйте на свой. Плюс тут в комментариях кавычки поменялись на другие, нужны двойне запятые, а не елочки

      • slava:

        Прошу прощения. Все заработало, но теперь в конечном файле идет вставка в 8 строку и данные при копировании в этот файл заменяются, а не встают на строку ниже.

        еще раз спасибо за поддержку.

        • excel:

          В этой строчке книгу и лист свои правильно указали?

          iLastRow = Workbooks («Книга1.xlsm»).Worksheets («Лист1»).Cells (.Rows.Count, 7).End (xlUp).Row + 1

  • Slava:

    Здравствуйте!

    Нуждаюсь в Вашей помощи.

    Есть макрос, который копирует нужные ячейки и переносит в сводную таблицу в этом же документе на «Лист2» помещая в таблицу .

    Вопрос. Как сделать всё тоже самое, но чтобы переносилось в другой файл.

    Sub Кнопка6 Щелчок()

    Dim iLastRow As Long

    With Worksheets («Лист2»)

    iLastRow = .Cells (.Rows.Count, 7).End (xlUp).Row + 1

    .Cells (iLastRow, 6) = ActiveCell

    .Cells (iLastRow, 2) = ActiveCell.Offset (, -1)

    .Cells (iLastRow, 3) = ActiveCell.Offset (, -2)

    .Cells (iLastRow, 5) = ActiveCell.Offset (, -3)

    .Cells (iLastRow, 4) = ActiveCell.Offset (, -4)

    .Cells (iLastRow, 7) = ActiveCell.Offset (, -5)

    .Cells (iLastRow, 1) = ActiveCell.Offset (, -6)

    End With

    End Sub

    Путь к нужному файлу например:C:\Users\Slava\Desktop\test\1.xlsm

    Ищу информацию уже три ночи, но не нахожу. Или мозги не доходят.

    Очень надеюсь на Вашу помощь.

    Заранее благодарен

    Слава

    • excel:

      Думаю так должно работать. Данные копируются из Книга1.xlsm Лист1 в 1.xlsm Лист1

      Sub Кнопка6()
      Dim iLastRow As Long
      Workbooks.Open Filename:="C:\Users\Slava\Desktop\test\1.xlsm"
      With Worksheets("Лист1")
      
      Workbooks("Книга1.xlsm").Activate
      iLastRow = Workbooks("Книга1.xlsm").Worksheets("Лист1").Cells(.Rows.Count, 7).End(xlUp).Row + 1
      Workbooks("1.xlsm").Worksheets("Лист1").Cells(iLastRow, 6) = ActiveCell
      Workbooks("1.xlsm").Worksheets("Лист1").Cells(iLastRow, 2) = ActiveCell.Offset(, -1)
      Workbooks("1.xlsm").Worksheets("Лист1").Cells(iLastRow, 3) = ActiveCell.Offset(, -2)
      Workbooks("1.xlsm").Worksheets("Лист1").Cells(iLastRow, 5) = ActiveCell.Offset(, -3)
      Workbooks("1.xlsm").Worksheets("Лист1").Cells(iLastRow, 4) = ActiveCell.Offset(, -4)
      Workbooks("1.xlsm").Worksheets("Лист1").Cells(iLastRow, 7) = ActiveCell.Offset(, -5)
      Workbooks("1.xlsm").Worksheets("Лист1").Cells(iLastRow, 1) = ActiveCell.Offset(, -6)
      Workbooks("1.xlsm").Save
      Workbooks("1.xlsm").Close
      End With
      End Sub
      

  • Максим:

    И еще вопрос.

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

    Заранее благодарен за ответ.

  • Максим:

    Спасибо, что откликнулись.

    К сожалению, файлов несколько. В имени файлов еще имеется «регион 1», «регион 2» и т.д. (которые постоянны). Меняется только дата в имени файла.

  • Максим:

    Здравствуйте!

    Подскажите, пожалуйста, а как прописать в коде имя файла, из которого копируются данные, если имя файла меняется в зависимости от недели года, т.е. «Данные 01.01.2014-07.01.2014.xlsx» и т.д. в течении года.

    Заранее благодарен.

    Максим

    • excel:

      Если в папке находится только один файл с таким расширение, как вариант вы можете использовать название в виде звездочки «*.xls», тогда он откроет с любым расширение формата xls

  • Юрий:

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

    • Сергей:

      Да если вручную то всё отлично копируется...

      • Сергей:

        Я понял в чём причина такого копирования. Как в коде изменить, чтобы копировалась не определённый диапазон листа, а весь лист, т.е. если бы я вручную кликнул над цифрой 1 и выделил весь лист, а затем его копировал и уже вставил в новый документ!

        • Юрий:

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

          'Открываем файл с которого нужно скопировать данные

          Workbooks.Open Filename:="C:Данные.xlsx"

          'Скопировать нужный диапазон в открывшейся книге на листе 1

          Workbooks («Данные.xlsx»).Worksheets («Лист1»).Activate

          Cells.Select

          Selection.Copy

          'Активируем нужную нам книгу

          Workbooks («Книга1.xlsm»).Worksheets («Лист1»).Activate

          Cells.Select

          ActiveSheet.Paste

          'Закрываем книгу откуда мы скопировали данные

          Workbooks («credit.xlsx»).Close

          End Sub

  • Сергей:

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

  • Сергей:

    Здравствуйте! А как будет выглядеть код: "Сначало открываем текущий лист, жмём кнопку вставить и с определённго файла который лежит где-то на диске копируется определённый диапазон, далее файл с которого копировали закрывается или даже не открывается для глаза пользователя... И всё на текущем листе мы имеем определённый скопированный диапазон...

    • excel:

      Добрый день! Дополнил статью ответом на ваш вопрос

      • Сергей:

        Что-то не получается... Наверное я где-то не то сделал, доходит до выделения копирования диапазона листа с которого нужно скопировать и пишет 400 ошибку.

        Вот такой код я вставил:

        Sub Вставить()

        'Открываем файл с которого нужно скопировать данные

        Workbooks.Open Filename:="C:\Централь — 2с и 1,2,3п.xls"

        'Скопировать нужный диапазон в открывшейся книге на листе 1

        Workbooks («Централь — 2с и 1,2,3п.xls»).Worksheets («2с и 1п»).Range («A1:CA1000»).Copy

        'Активируем нужную нам книгу

        Workbooks («Новый бланк.xls»).Activate

        'Выделяем и вставляем скопированные данные в ячейку А1

        ActiveWorkbook.Worksheets («Исковое заявление»).Range («A1»).Select

        ActiveSheet.Paste

        'Закрываем книгу откуда мы скопировали данные

        Workbooks («Централь — 2с и 1,2,3п.xls»).Close

        End Sub

        Централь — 2с и 1,2,3п.xls — это файл с которого нужно скопировать.

        2с и 1п лист с которого нужно скопировать в вышеназванном файле

        Новый бланк.xls это документ в который нужно скопировать

        Исковое заявление — это лист в файле Новый бланк в который нужно скопировать выделенный выше лист.

Добавить комментарий

Ваш e-mail не будет опубликован. Все поля обязательны для заполнения.