Question

我正在将名为“优先级列表”（包含60行）的工作表中的行复制到另一个名为“完成的项目”的工作表中，该工作单词“完成”或在第1列中完成。已完成的项目已预先存在行，因此我将附加到底部+ 1行。

到目前为止，附加工作，并没有错误消息。但问题是只有58行和60行复制过来。跳过第59行。我不知道为什么。

请指教。谢谢！

Sub DeleteOldProject()

    ActiveWorkbook.Sheets("Prioritization List").Activate
    Application.ScreenUpdating = False
    Application.ActiveSheet.UsedRange

    Dim x As Long
    Dim iCol As Integer
    Dim MaxRowList As Long
    'Dim MaxRowDone As Integer
    Dim S As String

    iCol = 1 'Filter on column A
    MaxRowList = Worksheets("Prioritization List").UsedRange.Rows.Count

    'For x = Cells(MaxRowList + 1, iCol).End(xlUp).Row To 1 Step -1
    For x = 1 To Cells(MaxRowList, iCol).Row 'Step 1
        S = Cells(x, 1).Value
        'MaxRowDone = Worksheets("Finished Projects").UsedRange.Rows.Count
        Sheets("Prioritization List").Select
        If S Like "Done" Or S Like "done" Then

            Sheets("Prioritization List").Select
            Rows(x).EntireRow.Copy
            Sheets("Finished Projects").Select
            Range("A1").Select
            Selection.End(xlDown).Select
            ActiveCell.Offset(1, 0).Select
            Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
'
'            Sheets("Prioritization List").Select
'            Rows(x).EntireRow.Delete

        End If
    Next

   Application.ScreenUpdating = True

End Sub

Answer 1

我无法解释为什么它不起作用，但你的做法存在缺陷。我试着稍微清理你的功能以提高稳定性。不幸的是，它没有经过测试，但它应该可以正常工作......

试试这个：

Sub ImprovedVersionMaybe()

    Dim x As Long
    Dim iCol As Integer
    Dim MaxRowList As Long
    Dim S As String

    Set wsSource = Worksheets("Prioritization List")
    Set wsTarget = Worksheets("Finished Projects")

    iCol = 1
    MaxRowList = wsSource.Cells(Rows.Count, iCol).End(xlUp).Row

    For x = MaxRowList to 1 Step -1
        S = wsSource.Cells(x, 1)
        If S = "Done" Or S = "done" Then
            AfterLastTarget = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1
            wsSource.Rows(x).Copy
            wsTarget.Rows(AfterLastTarget).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            wsSource.Rows(x).Delete
        End If
    Next

   Application.ScreenUpdating = True

End Sub

编辑：我很乐意详细介绍我根据要求提出的改进。

如果条件，复制并附加行到新工作表

1 个答案: