使用循環移動工作簿之間的數據範圍

Question

我發現代碼類似於以下情況，即使用循環將一個工作簿中的數據移動到另一個工作簿。代碼工作除了它移動的信息不正確。有人能告訴我爲什麼它不斷複製最後一列X次（其中X =行數）？我只想複製A2和J11之間的數據，而不是J2的X行和J3的X行，依此類推。

Sub CopySample() 
Dim wb1 As Workbook, wb2 As Workbook 
Dim ws1 As Worksheet, ws2 As Worksheet 
Dim lCol As Range, lRow As Range 
Dim CurCell_1 As Range, CurCell_2 As Range 

Application.ScreenUpdating = False 

'~~> Change as applicable 
Set wb1 = Workbooks("Sample1.xlsm") 
Set wb2 = Workbooks("OverallData_Month_X.xlsm") 
Set ws1 = wb1.Sheets("SampleSheet") 
Set ws2 = wb2.Sheets("All Cylinders Data") '<~~ Change as required 

For Each lCol In ws1.Range("A2:J11") 
'~~> Why this? 
Set CurCell_2 = ws2.Range("A2:J2") 
For Each lRow In ws1.Range("A2:J11") 
    Set CurCell_1 = ws1.Cells(lRow.Row, lCol.Column) 
    If Not IsEmpty(CurCell_1) Then 
     CurCell_2.Value = CurCell_1.Value 
     Set CurCell_2 = CurCell_2.Offset(1) 
    End If 
Next 
Next 

Application.ScreenUpdating = True 
End Sub 

Answer 1

未經檢驗的，但嘗試改變這一行Set CurCell_2 = ws2.Range("A2:J2")到：

Set CurCell_2 = ws2.Cells(1, lCol.Column) 

UPDATE

總體看來，上面的代碼設置它的工作簿的不同部分引用，抵消（移動）這些參考。我認爲有更高效的方法來做到這一點，並且更容易編寫代碼。所以雖然上面的答案只解決了你遇到的一半問題，但我已經在下面重寫了你的代碼，以便它可以讓你更加理解你的理解+更新。

我相信下面的代碼示例做了你要完成什麼：

（代碼中的註釋）

Sub CopySample 

Dim wb1 As Workbook, wb2 As Workbook 
Dim ws1 As Worksheet, ws2 As Worksheet 

Set wb1 = Workbooks("Sample1.xlsm") 
Set wb2 = Workbooks("OverallData_Month_X.xlsm") 
Set ws1 = wb1.Sheets("SampleSheet") 
Set ws2 = wb2.Sheets("All Cylinders Data") 

Dim rngCopyFromRange As Range 
Set rngCopyFromRange = ws1.Range("A2:J11") '- name the copy range for ease of read 

Dim rngPasteStartCell As Range 
Set rngPasteStartCell = ws2.Range("A2") 'top left cellt o begin the paste 


Dim lCurrentColumn As Long 
Dim lCurrentRow As Long 

    For lCurrentColumn = 1 To rngCopyFromRange.Columns.Count 'for each column in the source data 
     For lCurrentRow = 1 To rngCopyFromRange.Rows.Count '-for each row in each column in source data 
      'set the offset of the starting cell's value equal ot the top left cell in the source data offset by the same amount 
      '- where the offsets are equal to the row/column we are on - 1 
      rngPasteStartCell.Offset(lCurrentRow - 1, lCurrentColumn - 1).Value = _ 
       rngCopyFromRange.Cells(1, 1).Offset(lCurrentRow - 1, lCurrentColumn - 1).Value 
     Next lCurrentRow 
    Next lCurrentColumn 

End Sub