vba 将数据从一个工作簿复制到另一个

Copy over data from one workbook to another

提问by thedeepfield

I have an open workbook that has a bunch of macros in it, one of these macros is to copy data from this workbook and paste it into another workbook on a server. So far I can open the server workbook, and navigate to the right tab and cell but I cannot paste the data... My code is below:

我有一个打开的工作簿，里面有一堆宏，其中一个宏是从这个工作簿中复制数据并将其粘贴到服务器上的另一个工作簿中。到目前为止，我可以打开服务器工作簿，并导航到正确的选项卡和单元格，但无法粘贴数据......我的代码如下：

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

回答by brettdj

Something like below which will find a range from A2 to a cell contain "THE END" in column A of a sheet called "Month Count" in the ActiveWorbook, then open a second workbook ( I used C:\test\other.xlsm", goto sheet "A", and then put

类似于下面的内容，它会在 ActiveWorbook 中名为“Month Count”的工作表的 A 列中找到从 A2 到包含“THE END”的单元格的范围，然后打开第二个工作簿（我使用过C:\test\other.xlsm"，转到工作表“A”，然后放

• A2 from the first book into A2 of the second book,
• B2 from the first book into A3 in the second book,
• A3 from the first book into A4 in the second book,
• B3 from the first book into A5 in the second book etc

• 从第一本书的A2到第二本书的A2，
• 从第一本书的B2到第二本书的A3，
• 从第一本书的A3到第二本书的A4，
• 从第一本书B3到第二本书A5等

Note that in your code you are currently opening a new Excel instance, you should work on both workbooks in the same instance so that they can "talk"

请注意，在您的代码中，您当前正在打开一个新的 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

回答by Patrick Honorez

1. there is no point "activating" your workbooks.
2. you don't need to instantiate a second Excel if your macro is already running in Excel.
3. it would be much faster to do in one shot
4. I suspect your error comes from the fact xlwbookhas not been activated when you use xlwbook.ActiveCell.

1. 没有必要“激活”您的工作簿。
2. 如果您的宏已在 Excel 中运行，则您不需要实例化第二个 Excel。
3. 一次性完成会快得多
4. 我怀疑您的错误是由于xlwbook您使用xlwbook.ActiveCell.

Below is my proposal for your copy/paste thing, the one by one way (or I should say 2 by 2).

下面是我对你复制/粘贴的建议，一个一个（或者我应该说 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