代码仅在少数通过规则的条目上执行，而缺少通过规则的条目？

Question

早上好

我有一个针对COSHH的安全数据表数据库，我正在尝试创建一个函数，用户可以在其中输入一个日期到“ H7”中，并且输入日期少于该日期的任何内容都将占据整行转移到sheet2。

我编写的代码如下

Sub checkdatasheets()
Dim datefrom As Variant

'select first entry
Sheet1.Range("E2").Select

'continue until an empty cell is reached
Do Until ActiveCell.Offset(1, 0).Value = ""

If ActiveCell.Value = "" Then GoTo skipto:

'aquire date parameter
 datefrom = Sheet1.Range("H7")

 'if revision date is less than the date parameter copy and add to sheet2
  If ActiveCell.Value <= datefrom Then

        ActiveCell.Rows.EntireRow.Copy
        Sheets("Sheet2").Select
        NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
        Cells(NextRow, 1).Select
        ActiveSheet.Paste
        Sheets("Sheet1").Select

 End If

'move onto next cell
ActiveCell.Offset(1, 0).Select

Loop

skipto: MsgBox "Missing Data Sheet"

End Sub

我遇到的问题是，这段代码占用了某些行，但是错过了很多行，即使它们少于datefrom变量？

在此先感谢您的帮助，对于编写我的代码的任何反馈将不胜感激。

Answer 1

您应该避免使用select并更好地参考您的图纸。下面的代码应该可以更好地工作：

Sub checkdatasheets2()

For X = 2 To Sheets(1).Cells(Rows.Count, 5).End(xlUp).Row
    If Sheets(1).Cells(X, 5).Value < Sheets(1).Cells(7, 8).Value Then
        Sheets(1).Rows(X).Copy Destination:=Sheets(2).Range("A" & Sheets(2).Cells(Sheets(2).Rows.Count, 5).End(xlUp).Row + 1)
    End If
Next X

End Sub

Answer 2

在要导入日期的工作表的change事件中导入以下代码。

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim sDate As Date
    Dim LastRow1 As Long, LastRow2 As Long, i As Long

    If Not Intersect(Target, Range("A1")) Is Nothing Then

        If IsDate(Target.Value) Then
            sDate = CDate(Target.Value)
            LastRow1 = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row

            For i = 3 To LastRow1
                If CDate(Sheet1.Range("A" & i).Value) < sDate Then
                    LastRow2 = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row
                    Sheet1.Rows(i).Copy Sheet2.Rows(LastRow2 + 1)
                End If
            Next i
        Else
            MsgBox "Please insert a valid date."
        End If

    End If

End Sub

第1张（包括日期）

第2张（结果）