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

我试图复制并粘贴到不同的工作簿，并将这些数据分布在新工作簿中的不同工作表上。 我有我的VBA工作，但只有25％的时间。 我不断地在“运行时错误”1004“：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.Select每次都发生失败。 我需要把Next i直到每一个End If吗？

Answer 1

如果您只想传输值，则不需要使用“激活”，“select”或复制/粘贴。

 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与这个数组大小，并使用这种直接的方法来写/从目的地，它不是像不断select，激活，复制/粘贴，然后再select资源密集型等等

Answer 2

当你激活另一个表格/窗口时，你会混淆循环。 接下来i结束了在错误的工作表中的下一个单元格，这可能没有任何价值。

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