Excel VBA复制Rejected行代码每次运行重复数据，求优化方案

Hey there! Let's sort out that annoying duplicate copy issue with your project tracking Excel VBA. The root problem with your current code is that it has no way to tell which "Rejected" rows from the ARD2019 sheet have already been moved to Rejected—so it re-copies every matching row every time you run the button. Below are two practical, easy-to-implement solutions tailored for your needs (since you're modifying existing code, these are straightforward tweaks):

Solution 1: Add a "Copied" Flag Column (Simple & Reliable) #

This approach adds a hidden flag column in ARD2019 to mark rows that have already been copied. Once marked, the code will skip them on future runs.

Modified Code: #

Private Sub CommandButton1_Click()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastRowSource As Long
    Dim lastRowTarget As Long
    Dim i As Long
    
    ' Set worksheet references (makes code cleaner)
    Set sourceSheet = ThisWorkbook.Worksheets("ARD2019")
    Set targetSheet = ThisWorkbook.Worksheets("Rejected")
    
    ' Get last row with data in source sheet (column A)
    lastRowSource = sourceSheet.Cells(Rows.Count, 1).End(xlUp).Row
    
    ' Loop through source rows (start at row 2, assuming row 1 is headers)
    For i = 2 To lastRowSource
        ' Check if row is "Rejected" AND hasn't been copied yet
        If sourceSheet.Cells(i, 2).Value = "Rejected" And _
           sourceSheet.Cells(i, 26).Value <> "Copied" Then ' Column Z is column 26
            
            ' Copy the row to target sheet (no need to activate sheets!)
            sourceSheet.Rows(i).Copy targetSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
            
            ' Mark the row as copied in column Z
            sourceSheet.Cells(i, 26).Value = "Copied"
        End If
    Next i
    
    ' Clear copy mode
    Application.CutCopyMode = False
    
    ' Optional: Hide the flag column so users don't see it
    sourceSheet.Columns(26).Hidden = True
End Sub

Quick breakdown: #

• We use column Z (you can swap this for any unused column) to tag rows as Copied once they're moved.
• The code now only copies rows that are "Rejected" and haven't been marked before.
• Removed unnecessary sheet activation steps to make the code run faster and smoother.
• The optional line hides the flag column so it doesn't clutter your working sheet.

Solution 2: Check for Existing Rows in Target Sheet (No Extra Column Needed) #

If you don't want to add a flag column, this solution checks if the row already exists in the Rejected sheet before copying. We'll use column A as a unique identifier (adjust this if your unique ID is in another column, like an applicant ID column).

Modified Code: #

Private Sub CommandButton1_Click()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastRowSource As Long
    Dim i As Long
    Dim existingRow As Range
    
    Set sourceSheet = ThisWorkbook.Worksheets("ARD2019")
    Set targetSheet = ThisWorkbook.Worksheets("Rejected")
    
    lastRowSource = sourceSheet.Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To lastRowSource
        If sourceSheet.Cells(i, 2).Value = "Rejected" Then
            ' Check if the value from source column A exists in target column A
            Set existingRow = targetSheet.Columns(1).Find( _
                What:=sourceSheet.Cells(i, 1).Value, _
                LookIn:=xlValues, _
                LookAt:=xlWhole _
            )
            
            ' Only copy if the row doesn't exist in target
            If existingRow Is Nothing Then
                sourceSheet.Rows(i).Copy targetSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
            End If
        End If
    Next i
    
    Application.CutCopyMode = False
End Sub

How it works: #

• The Find method scans the target sheet's column A to see if the source row's unique value is already present.
• If the value isn't found (meaning the row hasn't been copied yet), it copies the row over.
• Note: This works best if column A has unique values. If your unique identifier is in another column, just change Columns(1) to match (e.g., Columns(3) for column C).

Both solutions are easy to drop into your existing code—just replace your current CommandButton1_Click sub with whichever one fits your workflow better. No manual deduplication needed anymore!

内容的提问来源于stack exchange，提问作者Caffeinated Frenzy