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

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

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

“激活”您的工作簿没有意义

如果宏已在Excel中运行，则无需实例化第二个Excel

一次完成会快得多

我怀疑您的错误是因为您使用

xlwbook.ActiveCell

时未激活

xlwbook

下面是我对你的复制/粘贴的建议，一个接一个的方式（或者我应该说是2乘2）

“激活”您的工作簿没有意义

如果宏已在Excel中运行，则无需实例化第二个Excel

一次完成会快得多

我怀疑您的错误是因为您使用

xlwbook.ActiveCell

时未激活

xlwbook

下面是我对你的复制/粘贴的建议，一个接一个的方式（或者我应该说是2乘2）

---

下面类似的内容将在ActiveWorbook中的一个名为“月数”的工作表的a列中找到从A2到单元格的范围，然后打开第二个工作簿（我使用了

C:\test\other.xlsm“

，转到工作表“a”，然后放入

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

请注意，在您的代码中，您当前正在打开一个新的Excel实例，您应该在同一实例中处理两个工作簿，以便它们可以“对话”

---

下面类似的内容将在ActiveWorbook中的一个名为“月数”的工作表的a列中找到从A2到单元格的范围，然后打开第二个工作簿（我使用了

C:\test\other.xlsm“

，转到工作表“a”，然后放入

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

请注意，在您的代码中，您当前正在打开一个新的Excel实例，您应该在同一实例中处理两个工作簿，以便它们可以“对话”

---

你知道你说代码中断的那一行的第二个字符是1（数字），而不是L（字母）？谢谢，是的，在问题中是这样的，但在我的代码中不是。它仍然不起作用…它是第一次中断循环，还是一次工作，然后第二次中断（因为您没有关闭服务器上的工作簿）？另外，当您可以在与第一个工作簿相同的应用程序对象中打开服务器工作簿时，为什么要创建新的

Excel.Application

？它没有完成第一个循环，无法通过x1wbook.worksheets（“月计数”）.activecell.value=mon.至于我为什么要创建一个新的excel.application，那是因为x1.visible=true行在没有第一个createObject的情况下会中断..我对vba不是很精通..只够应付一下..你知道你说代码中断的第二行字符是1（数字），而不是L（字母）吗？谢谢，是的，在问题中是这样的，但在我的代码中不是。它仍然不起作用…它是第一次通过循环中断，还是一次工作，然后第二次中断（因为您没有关闭服务器上的工作簿）？另外，当您可以在与第一个工作簿相同的应用程序对象中打开服务器工作簿时，为什么要创建新的

Excel.Application

？它没有完成第一个循环，无法通过x1wbook.worksheets（“月计数”）.activecell.value=mon.至于我为什么要创建一个新的excel.application，这是因为x1.visible=true行在没有第一个creatobject的情况下会中断..我对vba不是很精通..只够应付…谢谢，我会处理它.我是vba noob…我如何启用option explicit？我认为这不是一次就能完成的b因为我需要对来自不同来源的多个工作表执行此操作，并将总数相加..option explicit:您将其写入模块的最顶端。您还可以设置VBE选项，以便在创建新模块时自动插入该选项（位于工具、选项、需要变量声明中）谢谢你，我会处理它。我是vba noob…我如何启用option explicit？我不认为这可以一次性完成，因为我需要对来自不同来源的多个工作表执行此操作，并将总数相加。option explicit:您可以将其写在模块的最顶部。您还可以将VBE option设置为自动插入到模块中每当你创建一个新模块时（在工具、选项、要求变量声明中）哇，谢谢你，你的模块从一开始就工作了，只是插上电源，它就完成了！我需要对它进行一点修改，我不完全了解到底发生了什么，但我会研究它。再次感谢！感谢你的快速收尾。：）如果你的数据集很大，那么改型数组重写将大大缩短数据重新组织的时间，哇，谢谢你，你的从一开始就工作了，只是插上电源，它就完成了！我需要对它进行一点修改，我不完全理解到底发生了什么，但我会研究它。再次感谢！感谢你的快速收尾。：）如果数据集很大，则变量数组重写将显著缩短数据重新组织的时间，

    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  

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