Vba 如果单元格等于某个值，则复制Excel行

我试图复制并粘贴到另一个工作簿中，并将数据分布在新工作簿中的不同工作表上。我已经让我的VBA工作，但它只工作约25%的时间。我在“运行时错误'1004'：Range类的Select方法失败”上不断收到一个错误

以下是脚本：

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。每次选择
。如果
，我是否需要将下一个I

带到每个

结束的末尾
 激活另一张图纸/窗口时，会混淆循环。下一个
i
最后引用了错误工作表中的下一个单元格，该单元格在中可能没有值

如果必须激活

，请确保在循环的下一轮之前返回到原始工作表。这意味着您确实需要在sub开始时使用

Application.ScreenUpdate=False

，在sub结束时使用

Application.ScreenUpdate=True

。

如果您只想传输值，则无需使用Activate、Select或copy/paste

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行的范围，而只写39行（

.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

---

您可能不需要担心

屏幕更新

这样大小的数组，并且使用这种直接方法从/到目的地进行写入，它几乎不像连续选择、激活、复制/粘贴然后再次选择等那样占用大量资源。

您根本不需要使用选择功能…只是为了添加一个新的想法如果要修复它，请不要使用“活动”方法将

应用程序。屏幕更新

放在for循环内部或子循环的开始和结束处吗？@PortlandRunner我已尝试删除

I.Select

并使用

I.Rows

以避免您提到的“活动”方法，但这仍然具有相同的运行时间e错误。我的意思是不要使用ActiveSheet、ActiveWorkbook或ActiveCell。直接将工作簿和单元格定义为变量。@Benjooster-put

应用程序。屏幕更新

作为子循环的第一行和最后一行，在

For

循环之外。速度会快得多，并且不会出现令人讨厌的屏幕闪烁。t他非常感谢。你问的第一个问题是：他们都将进入一个新的文件，其中的表格实际上与我的价值相同。是的。第二个问题：数据是从一个网站上刮下来的，只在长excel表格中下载。这些数字中的每一个都对应于一个公司网站，因此数据在ori上的深度为750到900个单元格ginal电子表格，我希望数据在他们自己的表格上更具可读性。有意义吗？如果文件还没有打开，你会在

Set srcBook

或

Set destBook

行上得到一个

索引超出范围的错误。这是一个正确方法的好例子。得到我的投票-尽管我认为这是切换<代码>屏幕更新

在任何VBA脚本中都是很好的做法-你永远不知道未来的发展情况，闪烁的屏幕也不会让应用程序看起来更好！@Floris我添加了屏幕更新：）试试

…=i、 EntireRow.Value

。以上修订：）