Копирование данных из одной книги в другую

У меня есть открытая книга, в которой есть куча макросов, одним из этих макросов является копирование данных из этой книги и вставка их в другую книгу на сервере. Пока я могу открыть рабочую книгу сервера и перейти к правой вкладке и ячейке, но я не могу вставить данные … Мой код ниже:

Sub aggregate() Dim m As String Dim t As Integer 'opened workbook Sheets("Month Count").Select range("A2").Select Do m = ActiveCell.Value t = ActiveCell.Offset(0, 1).Value Set xl = CreateObject("Excel.Application") Set xlwbook = xl.Workbooks.Open("\\LOCATIONOFOTHERWORKBOOKONSERVER") xl.Visible = True xlwbook.Worksheets("A").range("A2").Select xlwbook.ActiveCell.Value = m **this is where my code breaks.** xlwbook.ActiveCell.Offset(1, 0).Value = t 'HOW TO SAVE FILE AND CLOSE FILE? Windows("GOBACKTOFIRSTWORKBOOK").Activate ActiveCell.Offset(1, 0).Select Loop Until ActiveCell.Value = "THE END" End Sub 

Что-то вроде ниже, которое найдет диапазон от A2 до ячейки, содержит «THE END» в столбце A листа под названием «Month Count» в ActiveWorbook, затем откройте вторую книгу (я использовал C:\test\other.xlsm" , goto sheet "A", а затем положить

  • A2 из первой книги в A2 второй книги,
  • B2 из первой книги в A3 во второй книге,
  • A3 из первой книги в A4 во второй книге,
  • B3 из первой книги в A5 во второй книге и т. Д.

Обратите внимание, что в вашем коде вы открываете новый экземпляр Excel, вы должны работать над обоими книгами в одном экземпляре, чтобы они могли «говорить»,

 Sub aggregate() Dim Wb1 As Workbook Dim Wb2 As Workbook Dim ws1 As Worksheet Dim ws2 As Worksheet Dim rng1 As Range Dim rng2 As Range Dim lngRow As Long Dim lngCalc As Long With Application .ScreenUpdating = False .EnableEvents = False lngCalc = .Calculation End With Set Wb1 = ActiveWorkbook Set ws1 = Wb1.Sheets("Month Count") Set rng1 = ws1.Columns("A").Find("THE END", , xlValues, xlWhole) If rng1 Is Nothing Then MsgBox "Did not find marker cell" GoTo QuickExit End If Set rng1 = ws1.Range(ws1.[a2], ws1.Cells(rng1.Row, "A")) Set Wb2 = Workbooks.Open("C:\test\other.xlsm") Set ws2 = Wb2.Sheets("A") For Each rng2 In rng1 ws2.[a2].Offset(lngRow, 0) = rng2 ws2.[a2].Offset(lngRow + 1, 0) = rng2.Offset(0, 1) lngRow = lngRow + 2 Next Wb2.Save Wb2.Close Wb1.Activate QuickExit: With Application .ScreenUpdating = True .EnableEvents = True .Calculation = lngCalc End With End Sub 
  1. нет смысла «активировать» ваши книги.
  2. вам не нужно создавать экземпляр второго Excel, если ваш макрос уже запущен в Excel.
  3. это было бы намного быстрее сделать одним выстрелом
  4. Я подозреваю, что ваша ошибка возникает из-за того, что xlwbook не был активирован, когда вы используете xlwbook.ActiveCell .

Ниже представлено мое предложение для вашей копии / вставки, один за другим (или я должен сказать 2 на 2).

  Sub aggregate2() Dim rngSource As Range Dim rngDest As Range Dim xlwbook As Workbook Set rngSource = Sheets("Month Count").Range("A2:B2") Set xlwbook = Workbooks.Open("\\LOCATIONOFOTHERWORKBOOKONSERVER") Set rngDest = xlwbook.Range("A2:B2") Do rngDest.Value = rngSource.Value Set rngSource = rngSource.Offset(1, 0) Set rngDest = rngDest.Offset(1, 0) Loop Until rngDest.Cells(1, 1) = "THE END" xlwbook.close End Sub 
Interesting Posts

Используйте ту же формулу и тот же диапазон, но на другой вкладке в Excel 2010

Открывая Oracle From Excel, он показывает ошибку «Указанный DSN содержит несоответствие архитектуры между Драйвером и Приложением»

Excel VBA для обновления документа открыт только для чтения

Excel VBA – вычисление среднего и стандартного dev на основе того, включен ли флажок

Обновление до Excel 2007 – приложение по-прежнему использует interop 2003

Создание экземпляров элементов управления ActiveX на листе с помощью vba

Есть ли способ добавить ссылку программно, которая уже упоминается в коде?

Обновление существующего файла Excel в Java Apache POI

Как вы извлекаете подмассив из массива в функцию листа?

VLOOKUP и интерполяция

Вытягивание данных в Excel с нескольких страниц

Excel VBA: найдите пустую ячейку и удалите строку

Excel объединяет формулы IF и SUMPRODUCT

Gembox, colorify Excell row

В VBA, не повезти сделать пасту вставить специальные

Давайте будем гением компьютера.