Vba 如果单元格=13，则将范围B11:E11复制到第2页 如果单元格E

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

如果单元格E>=13，则将范围B11:E11复制到第2页

---

如果单元格E看起来您的行已硬编码在副本中。我不确定您是否希望数据按顺序排列，换句话说，工作表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循环进行短循环。如果为空，则退出循环。这应该允许你的孩子表上的名字是连续的

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

对于First Brown：

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

-2016年10月18日编辑-

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

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 2016年10月18日-

关于测试前的运行，我认为您需要稍微不同的方法。我建议您使用我最喜欢的结构之一，字典结构。您需要从工具->引用将其添加到VBA中，并在Microsoft脚本运行时旁边打勾。一旦你这样做了，你就可以访问字典并利用它的智能感知

看看这个代码是否有意义。您可能需要一些小的调整，但我认为阅读和修改它非常容易：

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

---

而且，直到看到代码我才知道这些工作表实际上在使用表！这让事情变得容易多了。原始解决方案也可以重新设计，以利用表结构。

应为Cellsn，5.0

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

---

将范围参数更改为以下形式：范围B&n&:E&nIn除了Miqi180所说的之外，当前设置的方式将始终写入sheets2或sheet3的单元格B11:E11，是否应写入sheet2和/或sheets3？而不是新的一排。这就是你想要的，还是你想在每张纸上的下一个空行上写下你想要的？谢谢Miqi和Yow。我希望它转到下一行。由于对象的默认属性，Cellsn，5相当于Cellsn，5。在这种情况下的值。默认属性？？我不理解这部分，你怎么知道它的默认属性呢？Excel Range类的默认属性是Value。这意味着，如果使用范围索引器，则不必指定返回值的值。我实际上不喜欢它，更喜欢根据需要显式调用Value或Value2或Text，就像您所做的那样。这就是说，它确实是这样工作的，你会发现它被广泛接受并用作一种捷径，因此理解它很重要。我认为YowE3K的观点是，这一点本身并不是OP问题的原因，因为他的代码和你的@Hambone一样没有功能上的区别，我更喜欢显式地对属性进行编码，即使我知道在这种情况下，默认属性就是我正在使用的属性。Microsoft决定在未来版本的VBA中更改默认属性的可能性很小，例如，当强制转换为字符串时，他们可能决定Range对象的默认属性是.Address，但当强制转换为整数时，他们可能决定.Value属性。我发现如果显式地声明了属性，那么就更容易理解代码在做什么。这很有效。我试图添加代码，使其在其他工作表上工作，但当它复制到ws7时，它会跳过行，并且不会将12岁以下的数据复制到ws3。你能看看我做了什么吗？我修复了跳过行的问题，但我没有得到任何你可以将文档上传到G-Drive/Dropbox或其他任何东西的机会？这可能是很小的事情。小问题是最难发现的你会嘲笑这个问题。。。请参阅编辑。谢谢。成功了。我做的时候有两行空白？

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

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