我发现代码类似于以下代码,其中一个工作簿中的数据通过循环移动到另一个工作簿。代码工作除了它移动的信息不正确。有人能告诉我为什么它会不断复制最后一列X次(其中X =行数)?我想只在A2和J11之间复制一次数据而不是J行的J行J2和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
答案 0 :(得分:0)
未经测试,但请尝试将此行Set CurCell_2 = ws2.Range("A2:J2")
更改为:
Set CurCell_2 = ws2.Cells(1, lCol.Column)
<强>更新强>
总的来说,上面的代码似乎是设置它对工作簿的不同部分的引用,并抵消(移动)这些引用。我认为有更多有效的方法可以做到这一点,以及更简单的编码方式。所以虽然上面的答案只能解决你所遇到的一半问题,但我已经在下面重写了你的代码,以便你有更多的机会让你理解+更新。
我相信下面的代码示例会执行您要完成的任务:
(代码中的评论)
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