根據單元格值復制行，而不是在目標工作表上選擇下一個空行

Question

我編寫了一個簡短的 VBA 代碼，將行從一個工作表“報價跟蹤器”復制到另一個工作表“現金流”，一旦在“O”列中選擇了某個值（75 - 100%）。

我遇到的問題是這些行沒有復制到下一個可用的空行中，只是在工作表的下方。 我也無法停止多次復制同一行的代碼。

我可以添加什么以確保它們始終添加到“現金流”表的頂部或下一個可用行嗎？

我也無法將任何東西放在一起來檢測重復項，因此如果代碼運行不止一次，它只會不斷地將它們添加到“現金流量表”中。 可以添加任何東西來阻止這種情況嗎？

這是我到目前為止所擁有的：

Sub MoveRowBasedOnCellValue()
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("Quote Tracker").UsedRange.Rows.Count
J = Worksheets("Cashflow").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Cashflow").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Quote Tracker").Range("O1:O" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
    If CStr(xRg(K).Value) = "75 - 100%" Then
        xRg(K).EntireRow.Copy Destination:=Worksheets("Cashflow").Range("A" & J + 1)
        J = J + 1
    End If
Next
Application.ScreenUpdating = True
MsgBox "Jobs copied to Cashflow tab"
End Sub

如果您需要更多信息，請告訴我。 我是新來的，想給人留下好印象。

Answer 1

我已經編譯了一個滿足您需求的子程序。 我看到的第一個問題是您使用“On Error resume Next”。 這將使調試您的代碼幾乎不可能，因為代碼不會告訴您是否有錯誤，它只會跳過它。 我能看到的第二個問題是你讓問題變得比必要的復雜。 您使用了 For To 循環，其中 For Each 循環可以更輕松地完成工作。 我已經添加了一段代碼，一旦將其復制到“現金流”表中，該代碼就會使該行“P”列中的單元格的值超過 75%“轉移”。 該代碼還檢查該列中是否存在“已轉移”，如果存在，則跳過該值。 此外，代碼檢查 J 是否為 1，這將是復制的第一個值，如果不是，則將一個添加到計數器，以便它不會粘貼到上面行的頂部。

Sub MoveRowBasedOnCellValue()

Dim QTWs As Worksheet
Dim CWs As Worksheet
    Set QTWs = Worksheets("Quote Tracker")
    Set CWs = Worksheets("Cashflow")
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = QTWs.UsedRange.Rows.Count
J = CWs.Cells(Rows.Count, "O").End(xlUp).Row
If J <> 1 Then
    J = J + 1
End If
Set xRg = QTWs.Range("O1:O" & I)
Application.ScreenUpdating = False
For Each c In xRg
K = c.Row
    If c.Value < 0.75 Then
        'Do Nothing
    Else
        If QTWs.Cells(K, 16) <> "Transferred" Then
            QTWs.Rows(K).Copy Destination:=Worksheets("Cashflow").Range("A" & J)
            QTWs.Cells(K, 16).Value = "Transferred"
            J = J + 1
        Else
        'Do Nothing
        End If
    End If
Next
Application.ScreenUpdating = True
MsgBox "Jobs copied to Cashflow tab"
End Sub

如果您對它的工作原理有任何疑問，請隨時告訴我。 希望這可以幫助