0

我正在尝试复制并粘贴到不同的工作簿中，并将该数据分布在新工作簿内的不同工作表中。我已经让我的 VBA 工作了，但它只有大约 25% 的时间工作。我不断收到关于“运行时错误'1004'：范围类的选择方法失败”的错误。

这是脚本：

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？

4

2 回答 2

1

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

如果您必须这样做Activate，请确保在循环中的下一轮之前回到原始表格。这意味着你真的需要Application.ScreenUpdating = False在你的潜艇开始时，Application.ScreenUpdating = True最后......

于 2013-10-01T20:38:47.930 回答
1

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

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（它们是否都转到同一个文件中的工作表名称，对应于 的值i？如果是这样，这可能会更简单。

我很好奇你为什么要循环 1000 行的范围，但只写入 A39 的范围（.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

您可能不需要担心ScreenUpdating数组的这种大小，并且使用这种直接方法从目的地写入/写入目的地，它不像连续选择、激活、复制/粘贴然后再次选择那样占用资源，等等

于 2013-10-01T20:46:26.640 回答