0

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

1 回答 1

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
于 2012-09-14T18:16:13.080 回答