Question

我正在尝试运行一个代码，该代码将搜索列，查找关键字，然后将这些行复制并粘贴到另一个工作表中。不幸的是，当我逐步运行代码时，我可以看到它第一次尝试复制并粘贴一行时，它会复制活动单元格并将该值粘贴到下一页中的行中，并忽略“如果然后“语句搜索关键字。粘贴活动单元格值后，它可以正常工作并粘贴正确的行，但我无法弄清楚为什么它首先粘贴活动单元格。

Sub CompletedJob()

'Looks through the status column (N) of the Projects Overview table and moves them to Completed table, then deletes row from projects list
Dim Firstrow As Long
Dim lastRow As Long
Dim LrowProjectsOverview As Long

With Sheets("Projects Overview")
    .Select

    Firstrow = .UsedRange.Cells(1).Row
    lastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
    For LrowProjectsOverview = lastRow To Firstrow Step -1
        With .Cells(LrowProjectsOverview, "N")
            If Not IsError(.Value) Then
                If ((.Value = "Complete - Design") Or (.Value = "P4P") Or (.Value = "Ready for Setup")) Then .EntireRow.Select

    Selection.Copy
                Range("A600:Q600").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False

                If Sheet9.Range("B2").Value = "" Then
                Sheet9.Range("A2:Q2").Value = Sheet1.Range("A600:Q600").Value
                Sheet1.Range("A600:Q600").ClearContents

                Else

                Sheet9.Range("B2").EntireRow.Insert
                Sheet9.Range("A2:Q2").Value = Sheet1.Range("A600:Q600").Value
                Sheet1.Range("A600:Q600").ClearContents
                Sheet9.Range("B2:Q2").Interior.Color = xlNone
                Sheet9.Range("B2:Q2").Font.Bold = False
                Sheet9.Range("B2:Q2").Font.Color = vbBlack
                Sheet9.Range("B2:Q2").RowHeight = 14.25

            End If

            If Sheet9.Range("B2").Value = "" Then
               Sheet9.Range("B2").EntireRow.Delete

            End If

    If ((.Value = "Complete - Design") Or (.Value = "P4P") Or (.Value = "Ready for Setup")) Then .EntireRow.Delete

            End If
        End With
    Next LrowProjectsOverview
End With

End Sub

Answer 1

我试图重新创建你的问题。 我的代码不是您的直接解决方案。你需要根据你的问题进行调整。这很重要，因为这是您学习编码的方式。

我尽我所能尽可能地评论我的代码。我没有引用工作表，请添加此工具，因为您尝试从一个工作表复制到另一个工作表。

我不需要任何选择陈述。

这是我的vba代码。

Option Explicit

Sub SearchKeyandCopy()
Dim LastLine As Long
Dim i As Long
Dim j As Long
'Find Number of Rows in Status column (column D)
LastLine = Columns("D").Find("*", , , , xlByColumns, xlPrevious).Row

'Set row where it should start pasting
j = 2

'Iterate over all cells with status
For i = 2 To LastLine
    'Check if the Keyword (Key) is in Status column
    'InStr returns the position and 0 if not found
    'code checks if position is different from 0
    If InStr(Cells(i, "D").Value, "key") <> 0 Then
        'Copy values
        Range(Cells(i, "A"), Cells(i, "D")).Copy Destination:=Range(Cells(j, "F"), Cells(j, "I"))
        'increase counter for where to paste
        j = j + 1
    End If
Next i

End Sub

这是在运行代码之前的样子

这是运行代码后的样子

循环错误的Excel VBA

1 个答案: