尝试创建一个基于单元格值将行移动到其他工作表的循环

Question

I am trying to make a loop that checks for the string (defined by the user) in all the cells in column "A" and cuts every row where cell "A" doesn't contain the string and moves it to another sheet (Cml) I have the following code that runs without any error message but it doesn't seem to do what it's supposed to.

Sub PSFormat()
    Dim cb As Shape
    Dim Cml As Worksheet
    Dim Aud As Worksheet
    Dim z As Long, LastRow As Long
    Dim myDate2 As String

    Set Aud = Worksheets("CURRENT")
    Set Cml = Worksheets("OLD")


    myDate2 = InputBox("Please enter the date you are reviewing in yyyy-mm-dd format")

    With Aud
        LastRow = Aud.Cells(.Rows.Count, "A").End(xlUp).Row ' get last row with data in column "A"
        For z = 2 To LastRow
            If InStr(Aud.Range("A" & z).Value2, myDate2) < 0 Then ' check if current cell in column "A" contains "myDate2" defined by the user

            'if the cell in col "A" doesn't contain "myDate2" then cut the entire row and paste it to sheet Cml
                Aud.Rows((1) & z).EntireRow.Cut _
                Destination:=Cml.Rows((1) & z)
            End If
        Next z
    End With

    End Sub

Any help would be greatly appreciated!

[UPDATE] This is the entire macro for reference.

Sub PSFormat()
Dim cb As Shape
Dim Cml As Worksheet
Dim Aud As Worksheet
Dim z As Long, LastRow As Long
Dim myDate2 As String

Set Aud = Worksheets("CURRENT")
Set Cml = Worksheets("OLD")


myDate2 = InputBox("Please enter the date you are reviewing in yyyy-mm-dd format")

Aud.Range("A1").EntireRow.Insert

        Aud.Range("A1").Value = "TIME"
        Aud.Range("B1").Value = "ACTION"
        Aud.Range("C1").Value = "PLATFORM"
        Aud.Range("D1").Value = "MAKER ID"
        Aud.Range("E1").Value = "APPLICATION"
        Aud.Range("F1").Value = "JUSTIFICATION"

        Aud.Range("A1:F1").AutoFilter

LastRow = Aud.Cells(Rows.Count, "B").End(xlUp).Row

    For x = 1 To LastRow

                If Aud.Range("D" & x).Value <> "PSECSELF" Then Aud.Range("F" & x).Value = "A"
                If Aud.Range("D" & x).Value = "PSECSELF" Then Aud.Range("F" & x).Value = "N/A"
                If Aud.Range("B" & x).Value = "Unsuccessful login attempt" Then Aud.Range("F" & x) = "N/A"
                If Aud.Range("B" & x).Value = "Administrator login" Then Aud.Range("F" & x) = "N/A"
                If Aud.Range("B" & x).Value = "Remote help successful" Then Aud.Range("F" & x) = "N/A"
                If Aud.Range("B" & x).Value = "Helpdesk user deleted" Then Aud.Range("F" & x) = "N/A"
                If Aud.Range("B" & x).Value = "Token deleted" Then Aud.Range("F" & x) = "N/A"

Next x


With Aud
    LastRow = Aud.Cells(.Rows.Count, "A").End(xlUp).Row ' get last row with data in column "A"
    For z = 2 To LastRow
        If InStr(Aud.Range("A" & z).Value2, myDate2) < 0 Then ' check if current cell in column "A" contains "myDate2" defined by the user

        'if the cell in col "A" doesn't contain "myDate2" then cut the entire row and paste it to sheet Cml
            Aud.Range("A" & z).EntireRow.Cut _
            Destination:=Cml.Rows((1) & z)
        End If
    Next z
End With

  Aud.Range("F1").Value = "JUSTIFICATION"
  Aud.Range("F2").AutoFilter Field:=6, Criteria1:="A"

     Aud.Buttons.Add(617.25, 24, 72, 72).Select
        Selection.OnAction = "PSSaveFile"
            Selection.Characters.Text = "SAVE"

    Aud.Range("F2").Select


MsgBox "Please filter for yesterday's date first!"

End Sub

Answer 1

I would do the following but as noted in comments, you are leaving a gap in the range where you cut from. In which case, deleting the empty rows afterwards is a good idea. Assumes values in the sheet are formatted as strings.

Option Explicit

Sub PSFormat()
    Dim cb As Shape
    Dim Cml As Worksheet
    Dim Aud As Worksheet
    Dim z As Long, LastRow As Long
    Dim myDate2 As String
    Dim LastRowOld As Long
    Dim cutRange As Range

    Set Aud = Worksheets("CURRENT")
    Set Cml = Worksheets("OLD")

    myDate2 = InputBox("Please enter the date you are reviewing in yyyy-mm-dd format")

    With Aud

        LastRow = Aud.Cells(.Rows.Count, "A").End(xlUp).Row ' get last row with data in column "A"
        LastRowOld = Cml.Cells(.Rows.Count, "A").End(xlUp).Row

        For z = 2 To LastRow

             If Not IsEmpty(Aud.Range("A" & z)) And InStr(Aud.Range("A" & z).Value2, myDate2) =0 Then  Then ' check if current cell in column "A" contains "myDate2" defined by the user
                If Not cutRange Is Nothing Then
                    Set cutRange = Union(cutRange, Aud.Range("A" & z))
                Else
                    Set cutRange = Aud.Range("A" & z)
                End If

                'if the cell in col "A" doesn't contain "myDate2" then cut the entire row and paste it to sheet Cml
            End If
        Next z
    End With

    If Not cutRange Is Nothing Then
       cutRange.Copy Cml.Cells(LastRowOld, "A")
       cutRange.Delete
    End If

End Sub