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中名为“Month Count”的工作表的A列中包含“THE END”，然后打开第二个工作簿（我使用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

没有必要“激活”您的工作簿。
如果您的宏已在Excel中运行，则无需实例化第二个Excel。
一次拍摄会快得多
我怀疑您的错误来自于使用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

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

2 个答案: