將數據從一個工作簿複製到另一個工作簿

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稱爲「月計數」片的列A，然後打開第二個工作簿（I使用C:\test\other.xlsm"，轉到片材「A」，然後把

• A2從第一本書到第二本書的A2，
• B2從第一本書到A3在第二本書，
• A3從第一本書轉換成第二本書中的A4，
從第一本書到A5的第二本書等

注意，在你的代碼你正在打開一個新的Excel實例，你應該在這兩個工作簿工作在同一個實例

B3，使他們能夠「說話「

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