Копировать данные из одной рабочей книги в другую

Question

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

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

Answer 1

Пример ниже, где диапазон от A2 до ячейки содержит «КОНЕЦ» в столбце А листа «Счетчик месяцев» в ActiveWorbook, затем откройте вторую книгу (я использовал C:\test\other.xlsm", переход на лист).«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

Answer 2

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