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

我需要复制一个范围到一个新的工作表基于closures1个单元格中的数据我有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 

如果可能，我真的不鼓励select/复制/粘贴方法。 VBA有更好的移动数据的方法。 在上面的例子中，我们将整个范围的值移到另一个范围。

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

– 编辑 –

事实certificate，数据在那里！ 你只需要向下滚动看到它。

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

我build议你根据学生的名字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 –

下面是代码的一个简化版本，它使用相同的代码为所有三张表单执行。 我testing了它，它也不会跳过线条。

 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我认为你需要一个稍微不同的方法。 我build议你使用我最喜欢的结构之一，字典结构。 您需要从Tools-> References将其添加到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 

另外，我不知道，直到我看到这些表实际上使用表的代码！ 这使得它更容易。 原来的解决scheme也可以重新devise，以利用表结构。

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