使用单元格值将数据从一张纸复制到另一张纸

Question

我有一个工作表“数据”。 在此工作表中，我正在查看K列。如果它是红色，则我提取完整的行并将其复制到另一张“ Delay”工作表中。

我正在下面的代码。 该代码没有任何错误，但是，当我有12行时，它仅复制4行红色。

谁能帮助我找出我的错误之处以及我需要哪些改变？

Sub delay()
Dim cell As Range
Dim nextrow As Long
Dim a As Double

Application.ScreenUpdating = False
a = Application.WorksheetFunction.CountA(Sheets("Data").Range("K:K"))
For Each cell In Sheets("Data").Range("K5:K" & a)
If cell.DisplayFormat.Interior.Color = vbRed Then
nextrow = Application.WorksheetFunction.CountA(Sheets("Delayed").Range("K:K"))
Rows(cell.Row).Copy Destination:=Sheets("Delayed").Range("A" & nextrow + 1)
End If

Next
Application.ScreenUpdating = False
End Sub

Answer 1

首先：
WorksheetFunction.CountA计算不为空的单元格的数目以及参数列表中的值，您不能使用它来计算总行数或查找最后一行的数目（除非所有单元格都不为空） 。
您可能需要的是：

nmbRows = Workbook("WorkbookName").Worksheet("SheetName").Range("K" & Rows.Count).End(xlUp).Row

或不那么钝的东西。
使用CountA可能会导致搜索范围缩小，从而导致数据丢失，或者在您的情况下，将行插入错误的位置。
例：
的结果

Option Explicit
Sub test()
    Dim a As Long
    a = Application.WorksheetFunction.CountA(ThisWorkbook.Sheets("Ëèñò1").Range("A:A"))
    ThisWorkbook.Sheets("Ëèñò1").Range("B1").Value = a
End Sub

是

第二：
请谨慎，为每个range ， sheet添加参考

ThisWorkbook.Sheets("Data").Range("K5:K" & nmbRows)

这样一来，您就可以始终确定自己所指的是要检查的正确范围。

另一个注意事项：
我不是VBA专家，但是如果您是我，我将在宏的开头分别计算每张纸的行数，在循环中，我将使用nextrow=nextrow + 1结构而不是每次调用函数。