复制行中的某些单元格，满足criterea时粘贴到新的表单中

我试图从行中复制单元格A：D，当列E =“接受”，并将数据作为值粘贴到不同的工作表中。

每次我尝试，它只复制最后一行，我不明白为什么。 我会很感激任何帮助。

我的代码如下所示：

Public Sub AcceptLastChangeRequest() With Application .ScreenUpdating = False .EnableEvents = False End With On Error GoTo errorHandler: Dim varAnswer As String varAnswer = MsgBox("Are you sure you wish to accept the most recent Change Request?", vbYesNo, "Accept Change Request") If varAnswer = vbNo Then MsgBox ("No changes saved") With Application .ScreenUpdating = True .EnableEvents = True End With Exit Sub End If Dim SourceRange As Range, DestRange As Range Dim DestSheet As Worksheet, SourceSheet As Worksheet Dim LastRowDestSheet As Long, i As Long, LastRowSourceSheet As Long Set DestSheet = ThisWorkbook.Worksheets("Accepted Change Requests") Set SourceSheet = ThisWorkbook.Worksheets("All Change Requests") LastRowDestSheet = DestSheet.Cells(DestSheet.Rows.Count, "A").End(xlUp).Row LastRowSourceSheet = SourceSheet.Cells(SourceSheet.Rows.Count, "E").End(xlUp).Row For i = 2 To LastRowSourceSheet If Sheets("All Change Requests").Range("E" & i).Value = "Accepted" Then Set SourceRange = SourceSheet.Range("A" & i, "D" & i) Set DestRange = DestSheet.Range("A" & LastRowDestSheet + 1) SourceRange.Copy DestRange.PasteSpecial _ Paste:=xlPasteValues, _ operation:=xlPasteSpecialOperationNone, _ skipblanks:=False, _ Transpose:=False Application.CutCopyMode = False End If Next i With Application .ScreenUpdating = True .EnableEvents = True End With Exit Sub errorHandler: MsgBox ("There was an error adding this Change Request") Resume Next With Application .ScreenUpdating = True .EnableEvents = True End With End Sub 

Answer 1

您不更新目标工作表的最后一行。

放

 LastRowDestSheet = LastRowDestSheet + 1 

在if子句的末尾（在“Set DestRange = DestSheet.Range …”之后）

Answer 2

尝试用这个replace你的循环：

 For i = 2 To LastRowSourceSheet If SourceSheet.Range("E" & i).Value = "Accepted" Then _ DestSheet.Range("A" & LastRowDestSheet + 1 & ":D" & LastRowDestSheet + 1).Value = _ SourceSheet.Range("A" & i & ":D" & i).Value LastRowDestSheet = LastRowDestSheet + 1 Next i 

---

编辑 （更多OP请求）

 For i = 2 To LastRowSourceSheet If SourceSheet.Range("E" & i).Value = "Accepted" Then If Evaluate("ISERROR(MATCH(A" & i & ",'Accepted Change Requests'!A:A,0))") Then DestSheet.Range("A" & LastRowDestSheet + 1 & ":D" & LastRowDestSheet + 1).Value = _ SourceSheet.Range("A" & i & ":D" & i).Value LastRowDestSheet = LastRowDestSheet + 1 End If End If Next i