如何根據單元格值將行的內容從一個表移動到另一個表？

Question

我需要根據 Table1 的 H 單元格值將 Table1（范圍 A1:H24）中的一行內容移動到另一個 Table2（在與 Table1 不同的工作表上）。
前任。 如果 H24 = "Yes"，則將整行粘貼到 table2 上，從 table 1 中刪除。

該代碼從表 1 中刪除數據並將其粘貼到表 2 上，但每次運行模塊時，它會在表格下方粘貼。

Sub Archive()
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Inventory").UsedRange.Rows.Count
    J = Worksheets("Archive").UsedRange.Rows.Count
    If J = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Archive").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Inventory").Range("H1:H" & J)
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Yes" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Archive").Range("A" & J + 1)
            xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "Yes" Then
                K = K - 1
            End If
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Answer 1

@medicinal_nut 您提到的代碼與此處的代碼非常相似。
您可以通過不將原始代碼中的I替換為代碼中的J來更好地復制代碼。

Set xRg = Worksheets("Inventory").Range("H1:H" & J)

恕我直言，由於J=J+1 ，代碼正在做它應該做的事情。
它只是在存檔表中最后插入的行下方插入 1 個新行，否則，它只會用新復制的行覆蓋最后復制的行，恕我直言，這將是一種浪費。
可能我不明白您的問題，在這種情況下，請更清楚地說明您的問題。 或者，您也許能夠在我在第一行提到的網頁上找到可能滿足您需求的解決方案。

1 天后於 18JUL2021 編輯：為 OP 提供更易於理解的代碼

Option Explicit

Sub Archive()
Dim HColumnRows As Range
Dim InventoryUsedRows As Long
Dim ArchiveUsedRows As Long
Dim HColumnCurrentRow As Long
    InventoryUsedRows = Worksheets("Inventory").UsedRange.Rows.Count
    'ArchiveUsedRows can be directly manipulated here to set pasting point
    ArchiveUsedRows = Worksheets("Archive").UsedRange.Rows.Count
    If ArchiveUsedRows = 1 Then
        If Application.WorksheetFunction.CountA(Worksheets("Archive").UsedRange) = 0 Then ArchiveUsedRows = 0
    End If
    
    Set HColumnRows = Worksheets("Inventory").Range("H1:H" & InventoryUsedRows)

    On Error Resume Next

    Application.ScreenUpdating = False

    For HColumnCurrentRow = 1 To HColumnRows.Count
        If CStr(HColumnRows(HColumnCurrentRow).Value) = "Yes" Then
        'ArchiveUsedRows+n <- n can be changed to reset pasting point                
        HColumnRows(HColumnCurrentRow).EntireRow.Copy Destination:=Worksheets("Archive").Range("A" & ArchiveUsedRows + 1)
            HColumnRows(HColumnCurrentRow).EntireRow.Delete
            If CStr(HColumnRows(HColumnCurrentRow).Value) = "Yes" Then
                HColumnCurrentRow = HColumnCurrentRow - 1
            End If
            'ArchiveUsedRows+n where n can be changed to reset pasting point
            ArchiveUsedRows = ArchiveUsedRows + 1
        End If
    Next HColumnCurrentRow

    Application.ScreenUpdating = True
End Sub