根据条件将行复制到两个不同的电子表格

我有一个填充了一系列六位数字的列“B”。 我正在寻找我的代码来查找最后一个数字，根据结果（0到4或5到9），将其复制到一个单独的电子表格。 我有代码拿起列B中的每一行的最后一位数字，但不粘贴到右页：

For r = 1 To endRow ThisValue = Range("B" & r).Value LResult = Right(ThisValue, 1) If LResult = 0 Or 1 Or 2 Or 3 Or 4 Then Rows(r).Select Selection.Copy Sheets("Sheet2").Select Rows(pasteRowIndex).Select ActiveSheet.Paste pasteRowIndex = pasteRowIndex + 1 Sheets("Sheet1").Select Else Rows(r).Select Selection.Copy Sheets("Sheet3").Select Rows(pasteRowIndex).Select ActiveSheet.Paste pasteRowIndex = pasteRowIndex + 1 Sheets("Sheet1").Select End If Next r 

Answer 1

在使用多个工作表时，确保告诉Excel要使用哪些工作表非常重要 ，并且尽可能避免使用.Select 。

请看下面的代码。 我为工作表添加了一些variables。 我不是积极的哪张有你的ThisValue所以你可能需要编辑ws1必要的：

 Sub test() Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet Set ws1 = Sheets("Sheet1") Set ws2 = Sheets("Sheet2") Set ws3 = Sheets("Sheet3") endrow = ws1.Cells(ws1.Rows.Count, 2).End(xlUp).Row pasteRowIndex = 1 For r = 1 To endrow ThisValue = ws1.Range("B" & r).Value LResult = Right(ThisValue, 1) If LResult = 0 Or LResult = 1 Or LResult = 2 Or LResult = 3 Or LResult = 4 Then ws2.Rows(pasteRowIndex).Value = ws1.Rows(r).Value pasteRowIndex = pasteRowIndex + 1 Else ws3.Rows(pasteRowIndex).Value = ws1.Rows(r).Value pasteRowIndex = pasteRowIndex + 1 End If Next r End Sub 

此外，请尝试看看我是如何删除你的.Select ，并直接与单元格。

编辑：你在哪里定义了什么pasteRowIndex ？ 这不是在你提供的代码中，我假设你在别处有它，但你需要在这里。 那是什么？ 为了testing的目的，我为第一次迭代设置为1。 之后，它只是增加了一个这个数字。

此外，我删除了复制/粘贴，这可能会变得棘手/恼人的多张（在我看来），所以相反，我只是设置两行的值相等。 你能看到我是怎么做到的吗？

最后，当使用and或or检查一个variables的值，你必须每次重复逻辑。 看看我如何改变你的行包括LResult =每个数值？ 另一种方法，你可以做到这一点是If LResult <= 4 Then ...

Answer 2

我相信所有的条件都需要被拼写出来，所以而不是Or 1它应该是Or LResult = 1 。 但是使用Select Case可能会更好：

 Select Case LResult Case 0 To 4 ' ... Code Case Else ' ... Code End Select