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

我将名为Prioritization List（包含60行）的表格中的行复制到另一个名为Finished Projects的表单中，这些表单中包含单词“完成”或在列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

我不能解释为什么它不起作用，但你的做法是有缺陷的。 我试图清理你的function，以提高稳定性。 这不是testing，但不幸的是，它应该juuuust罚款…

尝试这个 ：

 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 

编辑：我会高兴地详细介绍了我提出的改进要求。