Question

我正在尝试复制并粘贴到不同的工作簿中，并将这些数据传播到新工作簿中的不同工作表中。我的VBA工作正常，但只有25％的时间才有效。我在“运行时错误'1004'上不断收到错误：选择Range类的方法失败”。

这是脚本：

Sub CopyData()

    Dim i As Range
    For Each i In Range("A1:A1000")

        Windows("data_1.xls").Activate
        Sheets("data_1").Activate
        If i.Value = 502 Then
            i.Select
            ActiveCell.Rows("1:1").EntireRow.Select
            Selection.Copy
            Windows("DataOne.xls").Activate
            Sheets("502").Range("A39").End(xlUp).Offset(1, 0).PasteSpecial
        End If
        If i.Value = 503 Then
            ........
        End If
     Next i
End Sub

每次i.Select都会发生失败。我需要将Next i带到每个End If的末尾吗？

Answer 1

当您激活另一个工作表/窗口时，会混淆循环。下一个i最终会引用错误工作表中的下一个单元格，这可能没有任何价值。

如果您必须Activate，请确保在循环中的下一轮之前返回原始工作表。这意味着你的子开头真的需要Application.ScreenUpdating = False，最后Application.ScreenUpdating = True ......

Answer 2

如果您只想传输值，则无需使用激活，选择或复制/粘贴。

Sub CopyData()

    Dim i As Range
    Dim srcBook as Workbook
    Dim destBook as Workbook

    Application.ScreenUpdating = False

    Set srcBook = Workbooks("data_1.xls")
    Set destBook = Workbooks("DataOne.xls")

    For Each i In srcBook.Sheets("data_1").Range("A1:A1000")
        Select Case i.Value
            Case 502
                destBook.Sheets("502").Range("A39").End(xlUp). _
                    Offset(1, 0).EntireRow.Value = i.EntireRow.Value
            Case 503
                destBook.Sheets("503").Range("A39").End(xlUp). _
                    Offset(1, 0).EntireRow.Value = i.EntireRow.Value
            Case 504
                'etc
            Case Else 
                'do nothing/ or do something for non-matching
        End Select
     Next i

    Application.ScreenUpdating = True
End Sub

如果我对If/Then结构和值的目的地有更多了解（它们都是在同一个文件中的工作表名称，对应于{{1的值），这可能会进一步简化如果是这样，这可能会更简单。

我很好奇为什么你要循环1000行的范围，但只写入A39的范围（i）......

从评论中更新：

.End(xlUp)

您可能不需要担心Sub CopyData() Dim i As Range Dim srcBook as Workbook Dim destBook as Workbook Set srcBook = Workbooks("data_1.xls") Set destBook = Workbooks("DataOne.xls") For Each i In srcBook.Sheets("data_1").Range("A1:A1000") destBook.Sheets(Cstr(i)).Range("A:A").End(xlUp).Offset(1,0). _ EntireRow.Value = i.EntireRow.Value Next i End Sub这个数组的大小，并使用这种直接方法从目的地写入/到目的地，它不像连续选择，激活那样耗费资源。复制/粘贴然后再次选择等。

如果Cell等于值，则复制Excel Row

2 个答案: