根据单元格值将行从一个Excel工作表复制到另一个工作表

我正在寻找一个简单的Excelmacros，可以从excel中的一张表中复制一行到另一张表格，这取决于单元格中是否有特定的数字/值。 我有两张床单。 一个叫“主人”，一个叫“top10”。

这是一个数据的例子。

这是我正在尝试使用的macros：

Sub MyMacro() Dim i As Long, iMatches As Long Dim aTokens() As String: aTokens = Split("10", ",") For Each cell In Sheets("master").Range("A:A") If (Len(cell.Value) = 0) Then Exit For For i = 0 To UBound(aTokens) If InStr(1, cell.Value, aTokens(i), vbTextCompare) Then iMatches = (iMatches + 1) Sheets("master").Rows(cell.Row).Copy Sheets("top10").Rows(iMatches) End If Next Next End Sub 

我敢肯定，我正在做一件非常愚蠢的事情，导致这种行为不起作用。 我可以运行macros本身没有任何错误，但没有得到复制到我正在编译的工作表。

Answer 1

If (Len(cell.Value) = 0) Then Exit For是无稽之谈。 像下面这样改变它：

 Sub MyMacro() Dim i As Long, iMatches As Long Dim aTokens() As String: aTokens = Split("10", ",") For Each cell In Sheets("master").Range("A:A") If Len(cell.Value) <> 0 Then For i = 0 To UBound(aTokens) If InStr(1, cell.Value, aTokens(i), vbTextCompare) Then iMatches = (iMatches + 1) Sheets("master").Rows(cell.Row).Copy Sheets("top10").Rows(iMatches) End If Next End If Next End Sub 

Answer 2

我相信你的代码在第一行数据之后停止的原因是因为你在下一行testing的单元格是空的（在你的示例电子表格中），因此你退出循环（因为Len(cell.Value) = 0 ）。 我会build议一个不同的方法： 先进的过滤器正是你所需要的，而且更快。 在您的示例电子表格中，您将需要插入一个空行2并将公式“= 10”放在单元格A2中。 然后下面的代码将做你所需要的（假设master是ActiveSheet）：

 Sub CopyData() Dim rngData As Range, lastRow As Long, rngCriteria As Range With ActiveSheet ' This finds the last used row of column A lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row ' Defines the criteria range - you can amend it with more criteria, ' it will still work ' 22 is the number of the last column in your example spreadsheet Set rngCriteria = .Range(.Cells(1, 1), .Cells(2, 22)) ' row 2 has the filter criteria, but we will delete it after copying Set rngData = .Range(.Cells(1, 1), .Cells(lastRow, 22)) ' Make sure the destination sheet is clear ' You can replace sheet2 with Sheets("top10"), ' but if you change the sheet name your code will not work any more. ' Using the vba sheet name is usually more stable Sheet2.UsedRange.ClearContents ' Here we select the rows we need based on the filter ' and copy it to the other sheet Call rngData.AdvancedFilter(xlFilterCopy, rngCriteria, Sheet2.Cells(1, 1)) ' Again, replacing Sheet2 with Sheets("top10").. ' Row 2 holds the filter criteria so must be deleted Sheet2.Rows(2).Delete End With End Sub 

有关高级filter的参考，请查看以下链接： http : //chandoo.org/wp/2012/11/27/extract-subset-of-data/

Answer 3

正如@Ioannis所提到的，你的问题是在你的If (Len(cell.Value) = 0) Then Exit For ，主A3中的空单元格， If (Len(cell.Value) = 0) Then Exit For

而不是使用， if要检测您的范围的结束，我用下面的代码：

 LastRow= Sheets("master").Cells(Cells.Rows.Count, "A").End(xlUp).Row Set MyRange = Sheets("master").Range("A1:A" & LastRow) 

由此产生的代码是这样的：

 Sub MyMacro() Dim i As Long, iMatches As Long Dim aTokens() As String: aTokens = Split("10", ",") Dim LastRow Dim MyRange LastRow = Sheets("master").Cells(Cells.Rows.Count, "A").End(xlUp).Row Set MyRange = Sheets("master").Range("A1:A" & LastRow) For Each cell In MyRange For i = 0 To UBound(aTokens) If InStr(1, cell.Value, aTokens(i), vbTextCompare) Then iMatches = (iMatches + 1) Sheets("master").Rows(cell.Row).Copy Sheets("top10").Rows(iMatches) End If Next Next End Sub 

我testing了这个工作簿，它完美的作品。 🙂