循环停止太快

该代码应该通过一系列的数据，并在两个不同的列中search特定的variables，并将数据粘贴到另一个表单中。 我没有得到正确的结果（Christo和Paid）。

以下是代码。

Sub Cop() Dim x As Integer Dim y As Integer Dim z As Integer Dim a As Integer Dim NumRows As Long Sheets("Not_Paid").Select If Range("B2") = 1 And Range("B4") = 1 Then Sheets("Microinvest").Select Range("A1").Select ' Set numrows = number of rows of data. NumRows = Range(ActiveCell, ActiveCell.End(xlDown)).Rows.Count ' Establish "For" loop to loop "numrows" number of times. For x = 1 To NumRows y = x + 1 z = x + 7 a = x - 1 Sheets("Microinvest").Select Range("A" & y).Select If ActiveCell.Offset(a, 2) = "Christo" And ActiveCell.Offset(a, 4) = "Paid" Then Range("A" & y, "F" & y).Select Selection.Copy Sheets("Not_Paid").Select Range("A" & z).Select ActiveSheet.Paste End If Next End If Sheets("Not_Paid").Select End Sub 

这里是我正在使用的数据的一个示例：

数据 输出

我得到值Blagoevgrad和NotPaid不应该被拿起。 或者至less这是我在印象之下会发生的事情。

此外，xvariables循环84行而不是389，这是我的范围的实际行号。

Answer 1

我认为这工作：

 Sub Cop() Dim nRows As Long, rw As Long, cnt As Long cnt = 10 'Start output in row 10 on sheet Not_Paid If Worksheets("Not_Paid").Range("B2") = 1 And Worksheets("Not_Paid").Range("B4") = 1 Then With Sheets("Microinvest") nRows = .Range("A1").End(xlDown).Row For rw = 1 To nRows If .Range("A" & rw).Offset(0, 2) = "Christo" And .Range("A" & rw).Offset(0, 4) = "Paid" Then .Range("A" & rw & ":F" & rw).Copy Destination:=Worksheets("Not_Paid").Range("B" & cnt) cnt = cnt + 1 End If Next End With End If End Sub