Question

我尝试从一行复制单元格A：D，当列E =＆＃34;接受＆＃34;，并将数据作为值粘贴到另一张表格中。

每次尝试时，它只复制最后一行，我无法理解原因。我真的很感激任何帮助。

我的代码如下所示：

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子句的末尾（在＆＃39;设置DestRange = DestSheet.Range ...＆＃39;之后）

Answer 2

尝试用以下方法替换你的循环：

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

满足条件时，从行中复制某些单元格，并粘贴到新工作表中

2 个答案: