如果單元格遵循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