根據列中的條件將行從一個工作表復制到另一個工作表

Question

此工作簿是為用戶表單設置的，用於輸入 PO 信息，以便可以將其添加到動態 PO 日志中。 登錄后，用戶將關閉用戶表單和 select 和 comboBox 值 Yes 或 No 以指示是否應從每月預算中扣除此 PO。

如果用戶選擇否，則應將整行復制到工作簿的下一頁，也就是下個月。 僅當 comboBox 值 = 否時，才應通過 Worksheet Selection_Change 事件發生這種情況。
如果用戶選擇是，其他公式會將值添加到總扣除額中，因此循環應該忽略它。

此工作簿中的頁面完全相同，因此第二個月的范圍將與第一個月的 C14:H14 相同，后者再次根據選擇的 NO 值的數量動態更新。

我無法僅找到 No 值並將行 C14:H14 復制到下一個工作表中的下一個可用行。

Sub Transfer()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lRow1 As Long
Dim lRow2 As Long
Dim i As Long
Dim Crit As Range

Set ws1 = ActiveSheet
Set ws2 = ActiveSheet.Next

lRow1 = ws1.Range("J" & Rows.Count).End(xlUp).Row

For i = 14 To lRow1
    If ws1.Cells(i, 10).Value = "No" Then

        ws1.Range("C" & i & ":H" & lRow1).Copy
        ws2.Activate

        lRow2 = ws2.Range("J" & Rows.Count).End(xlUp).Offset(1, 0).Row

        ws2.Range("C14:H" & lRow2).PasteSpecial Paste:=xlPasteValues
    End If
Next i

End Sub

此代碼復制最后兩個數據點並忽略條件。 如果它們在整個數據集中混合，它將復制 Yes 和 No。

Answer 1

您只需要復制每一行 - 您正在復制整個行塊

Sub Transfer()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lRow1 As Long
    Dim lRow2 As Long
    Dim i As Long
    Dim Crit As Range
    
    Set ws1 = ActiveSheet
    Set ws2 = NextVisibleWorksheet(ws1) 'find next sheet
    If ws2 Is Nothing Then  'check we got a sheet
        msgbox "No sheet found after " & ws1.Name
        Exit sub
    End If
    
    lRow1 = ws1.Range("J" & Rows.Count).End(xlUp).Row
    lRow2 = ws2.Range("J" & Rows.Count).End(xlUp).Offset(1, 0).Row

    For i = 14 To lRow1
        If ws1.Cells(i, 10).Value = "No" Then
            With ws1.Range("C" & i & ":H" & i)
                ws2.Cells(lRow2, "C").Resize(1, .Columns.Count).Value = .Value
                lRow2 = lRow2 + 1
            End With
        End If
    Next i

End Sub

'given a worksheet, find the next visible sheet (if any)
Function NextVisibleWorksheet(ws As Worksheet)
    Dim rv As Worksheet
    Set rv = ws.Next 'does not raise an error if no more sheets...
    If Not rv Is Nothing Then
        Do While rv.Visible <> xlSheetVisible
            Set rv = rv.Next
            If rv Is Nothing Then Exit Do 'edit - added this check
        Loop
    End If
    Set NextVisibleWorksheet = rv
End Function