如果单元格 <= 值，则复制范围

Question

我需要根据 1 个单元格中的数据将范围复制到新工作表中，我有 100 行数据。 数据从第 11 行开始。

如果单元格 E >= 13 将范围 B11:E11 复制到工作表 2
如果单元格 E <= 12 将范围 B11:E11 复制到工作表 3

Sheets1.Select
For n = 11 To 129
If Cells(n, 5) >= 13 Then
Range("B" & n, "E" & n).Copy sheets2.Range("B11")
Else
Range("B" & n, "E" & n).Copy sheet3.Range("B11")
End If
Next n

我究竟做错了什么？

谢谢

编辑：
谢谢大家的帮助。 这是我现在所拥有的。

Sub ConditionalCopy()

  Dim ws1, ws2, ws3, ws4, ws5, ws6, ws7, ws As Worksheet
  Dim row1, row2, row3, row4, row5, row6, row7, row As Integer

  Set ws1 = Worksheets("1ST BROWN")
  Set ws2 = Worksheets("1ST BROWN NOTES")
  Set ws3 = Worksheets("KIDS BROWN NOTES")
  Set ws4 = Worksheets("2ND BROWN")
  Set ws5 = Worksheets("2ND BROWN NOTES")
  Set ws6 = Worksheets("3RD BROWN")
  Set ws7 = Worksheets("3RD BROWN NOTES")

  row2 = 10
  row3 = 10

  For row1 = 11 To 129
    If ws1.Cells(row1, 5).Value >= 13 Then
      Set ws = ws2
      row2 = row2 + 1
      row = row2
    Else
      Set ws = ws3
      row3 = row3 + 1
      row = row3
    End If

    ws.Range("B" & row & ":E" & row).Value = _
      ws1.Range("B" & row1 & ":E" & row1).Value

  Next row1

  row5 = 10

  For row4 = 11 To 129
    If ws4.Cells(row4, 5).Value >= 13 Then
      Set ws = ws5
      row5 = row5 + 1
      row = row5
    Else
      Set ws = ws3
      row3 = row3 + 1
      row = row3
    End If

    ws.Range("B" & row & ":E" & row).Value = _
      ws4.Range("B" & row4 & ":E" & row4).Value

  Next row4

  row7 = 10

  For row6 = 11 To 129
    If ws6.Cells(row6, 5).Value >= 13 Then
      Set ws = ws7
      row7 = row7 + 1
      row = row7
    Else
      Set ws = ws3
      row3 = row3 + 1
      row = row3
    End If

    ws.Range("B" & row & ":E" & row).Value = _
      ws6.Range("B" & row6 & ":E" & row6).Value

  Next row6


End Sub

Answer 1

看起来您在副本中硬编码了您的行。 我不确定你是否想要数据顺序（换句话说，工作表 1 有 100 行，所以工作表 2 + 3 应该总共 100 行，没有间隙），或者如果你想要同一行的数据，它在工作表 1 中。此示例假设没有间隙。

Sub ConditionalCopy()

  Dim ws1, ws2, ws3, ws As Worksheet
  Dim row1, row2, row3, row As Integer

  Set ws1 = Sheets(1)
  Set ws2 = Sheets(2)
  Set ws3 = Sheets(3)

  row2 = 10
  row3 = 10

  For row1 = 11 To 129
    If ws1.Cells(row1, 5).Value >= 13 Then
      Set ws = ws2
      row2 = row2 + 1
      row = row2
    Else
      Set ws = ws3
      row3 = row3 + 1
      row = row3
    End If

    ws.Range("B" & row & ":E" & row).Value = _
      ws1.Range("B" & row1 & ":E" & row1).Value

  Next row1

End Sub

如果可能，我真的不鼓励选择/复制/粘贴方法。 VBA 有更好的方法来移动数据。 在上面的示例中，我们从整个范围中获取值并将它们移动到另一个范围。

看看这是否接近你的想法。

- 编辑 -

原来，数据就在那里！ 您只需要向下滚动即可看到它。

问题是它仍在移动数据行，即使没有要移动的“真实”数据。 您正在迭代第 11 到 129 行并进行复制，即使是空白行。

我建议您根据学生的姓名缩短每个for循环。 如果为空，则退出循环。 这应该允许您的“孩子”表上的名称是连续的。

以下是一些可以做到这一点的片段：

对于“第一布朗：”

For row1 = 11 To 129

  If ws1.Cells(row1, 4).Value = "" Then
    Exit For
  End If

“第二个布朗：”

For row4 = 11 To 129

  If ws4.Cells(row4, 4).Value = "" Then
    Exit For
  End If

“第三个布朗：”

For row6 = 11 To 129

  If ws4.Cells(row6, 4).Value = "" Then
    Exit For
  End If

-- 编辑 10/18/2016 --

这是代码的简化版本，它使用相同的代码对所有三个工作表执行此操作。 我测试了它，它似乎也没有跳线。

Sub ConditionalCopy()

  Dim source, destination, kids, ws As Worksheet
  Dim iteration, sRow, dRow, kRow, row As Integer

  Set kids = Worksheets("KIDS BROWN NOTES")
  kRow = 10

  For iteration = 1 To 3
    sRow = 10
    dRow = 10

    If iteration = 1 Then
      Set source = Worksheets("1ST BROWN")
      Set destination = Worksheets("1ST BROWN NOTES")
    ElseIf iteration = 2 Then
      Set source = Worksheets("2ND BROWN")
      Set destination = Worksheets("2ND BROWN NOTES")
    Else
      Set source = Worksheets("3RD BROWN")
      Set destination = Worksheets("3RD BROWN NOTES")
    End If

    For sRow = 11 To 129
      If source.Cells(sRow, 4).Value = "" Then
        Exit For
      End If

      If source.Cells(sRow, 5).Value >= 13 Then
        Set ws = destination
        dRow = dRow + 1
        row = dRow
      Else
        Set ws = kids
        kRow = kRow + 1
        row = kRow
      End If

      ws.Range("B" & row & ":E" & row).Value = _
          source.Range("B" & sRow & ":E" & sRow).Value
    Next sRow
  Next iteration

End Sub

-- 编辑 2 10/18/2016 --

关于Run_Before_Test我认为你想要一个稍微不同的方法。 我建议您使用我最喜欢的结构之一，即字典结构。 您需要从 Tools->References 在 VBA 中添加它，并在“Microsoft Scripting Runtime”旁边打勾。 一旦你这样做了，你就可以访问字典并利用它的智能感知。

看看这段代码是否有意义。 您可能需要稍作调整，但我认为阅读（和修改）很容易：

Sub RunBeforeTest()
  Dim BeltSheet As New Dictionary
  Dim RowNumbers As New Dictionary
  Dim master As ListObject
  Dim lr As ListRow
  Dim source, dest As Worksheet
  Dim row As Integer

  BeltSheet.Add "Jr. Black", Sheets("BLACK")
  BeltSheet.Add "1st Black", Sheets("BLACK")
  BeltSheet.Add "2nd Black", Sheets("BLACK")
  BeltSheet.Add "3rd Black", Sheets("BLACK")
  BeltSheet.Add "4th Black", Sheets("BLACK")
  BeltSheet.Add "5th Black", Sheets("BLACK")
  BeltSheet.Add "6th Black", Sheets("BLACK")
  BeltSheet.Add "1st Brown", Sheets("1ST BROWN")
  BeltSheet.Add "2nd Brown", Sheets("2ND BROWN")
  BeltSheet.Add "3rd Brown", Sheets("3RD BROWN")
  RowNumbers.Add Sheets("BLACK"), 11
  RowNumbers.Add Sheets("1ST BROWN"), 11
  RowNumbers.Add Sheets("2ND BROWN"), 11
  RowNumbers.Add Sheets("3RD BROWN"), 11

  Set master = Sheets("MASTER").ListObjects("Table2")
  For Each lr In master.ListRows
    If lr.Range(1, 1).Value = "" Then
      Exit For
    End If

    Set ws = BeltSheet(lr.Range(1, 1).Value)
    row = RowNumbers(ws)

    ws.Range("B" & row & ":E" & row).Value = lr.Range.Value

    RowNumbers(ws) = row + 1
  Next lr
End Sub

另外，直到我看到那些代码，我才知道这些工作表实际上是在使用表格！ 这使它变得容易得多。 还可以重新设计原始解决方案以利用表结构。

Answer 2

应该是 Cells(n,5).Value

Sheets1.Select
For n = 11 To 129
If Cells(n, 5).Value >= 13 Then
Range("B" & n, "E" & n).Copy sheets2.Range("B11")
Else
Range("B" & n, "E" & n).Copy sheet3.Range("B11")
End If
Next n