如何在一個循環內複製粘貼行如果一個單元格符合if條件vba

Question

我構建了一個宏來複制包含符合if條件的單元格的粘貼行。這個宏測量一行的4對單元格之間的差值，如果差值大於所需值，則它複製粘貼該行，即包含「有罪」值的單元格（如果全部4個比較不符合限制）屬於（或他們），在不同的工作表（「WFRandVFR_performance」）。最後，它會使「有罪」的細胞變色。一切正常，除了粘貼部分，它提供了以下：

Sheets("WFRandVFR_performance").Select 
    Range("A" & Rows.Count).End(xlUp).Offset(1).Select 
    ActiveSheet.Paste 

下面我張貼宏

Sub WFRandVFR_performance() 

     Application.Calculation = xlCalculationManual 
     Application.ScreenUpdating = False 
     Application.EnableEvents = False 

    Sheets("Tracker").Select 

     Dim mDiff1 As Double 
     mDiff1 = 0.01 
     Dim mDiff2 As Double 
     mDiff2 = 0.03 
     Dim mDiff3 As Double 
     mDiff3 = 0.01 
     Dim mDiff4 As Double 
     mDiff4 = 0.03 

     Sheets("Tracker").Select 
     For Each cell1 In Range(Range("U2"), Range("U2").End(xlDown)) 
     If cell1.Value - cell1.Offset(0, 1).Value > mDiff1 Or cell1.Value - cell1.Offset(0, 2).Value > mDiff2 Then 
     cell1.EntireRow.Copy 
     Sheets("WFRandVFR_performance").Select 
     Range("A" & Rows.Count).End(xlUp).Offset(1).Select 
     ActiveSheet.Paste 
     End If 
     Next cell1 

     Sheets("Tracker").Select 
     For Each cell2 In Range(Range("AB2"), Range("AB2").End(xlDown)) 
     If cell2.Value - cell2.Offset(0, 1).Value > mDiff3 Or cell2.Value - cell2.Offset(0, 2).Value > mDiff4 Then 
     cell2.EntireRow.Copy 
     Sheets("WFRandVFR_performance").Select 
     Range("A" & Rows.Count).End(xlUp).Offset(1).Select 
     ActiveSheet.Paste 
     End If 
     Next cell2 

     Sheets("WFRandVFR_performance").Select 

     Columns(4).RemoveDuplicates Columns:=Array(1) 
     On Error Resume Next 
     Columns(4).SpecialCells(xlBlanks).EntireRow.Delete 

     For Each cell3 In Range(Range("U2"), Range("U2").End(xlDown)) 
     If cell3.Value - cell3.Offset(0, 1).Value > mDiff1 Then 
     cell3.Offset(0, 1).Interior.ColorIndex = 3 
     End If 
     If cell3.Value - cell3.Offset(0, 2).Value > mDiff2 Then 
     cell3.Offset(0, 2).Interior.ColorIndex = 5 
     End If 
     Next cell3 

     For Each cell4 In Range(Range("AB2"), Range("AB2").End(xlDown)) 
     If cell4.Value - cell4.Offset(0, 1).Value > mDiff3 Then 
     cell4.Offset(0, 1).Interior.ColorIndex = 3 
     End If 
     If cell4.Value - cell4.Offset(0, 2).Value > mDiff4 Then 
     cell4.Offset(0, 2).Interior.ColorIndex = 5 
     End If 
     Next cell4 

     Sheets("WFRandVFR_performance").Select 
     If Not ActiveSheet.AutoFilterMode Then 
     ActiveSheet.Rows(1).AutoFilter 
     End If 

    Application.Calculation = xlCalculationAutomatic 
    Application.ScreenUpdating = True 
    Application.EnableEvents = True 

    End Sub 

Answer 1

你能找到的最後一行是這樣的：

Dim LR as Long 
LR = Sheets("WFRandVFR_performance").Cells(Sheets("WFRandVFR_performance").Rows.Count, 1).End(xlUp).Row 

cell1.EntireRow.Copy Sheets("WFRandVFR_performance").Range("A" & LR+1) 

---

另一種選擇，可能是最好的（避免複製/粘貼）：

Dim LR as Long 
LR = Sheets("WFRandVFR_performance").Cells(Sheets("WFRandVFR_performance").Rows.Count, 1).End(xlUp).Row 

Sheets("WFRandVFR_performance").Range("A" & LR+1).Value=cell1.EntireRow.Value 

---

把這個放入你的代碼：

Dim LR as Long 

Sheets("WFRandVFR_performance").Rows(1).Value=Sheets("Tracker").Rows(1).Value 

    For Each cell1 In Range(Range("U2"), Range("U2").End(xlDown)) 
     If cell1.Value - cell1.Offset(0, 1).Value > mDiff1 Or cell1.Value - cell1.Offset(0, 2).Value > mDiff2 Then 
      LR = Sheets("WFRandVFR_performance").Cells(Sheets("WFRandVFR_performance").Rows.Count, 2).End(xlUp).Row 
      Sheets("WFRandVFR_performance").Range("A" & LR+1).Value=cell1.EntireRow.Value 
     End If 
    Next cell1