使用循环在工作簿之间移动数据范围

时间:2012-09-14 18:08:11

标签: excel vba

我发现代码类似于以下代码,其中一个工作簿中的数据通过循环移动到另一个工作簿。代码工作除了它移动的信息不正确。有人能告诉我为什么它会不断复制最后一列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

1 个答案:

答案 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