excel - 根据列中的条件将行从一个工作表复制到另一个工作表

Question

此工作簿是为用户表单设置的，用于输入 PO 信息，以便可以将其添加到动态 PO 日志中。登录后，用户将关闭用户表单并选择组合框值是或否来指示是否应从每月预算中扣除此采购订单。
如果用户选择否，则应将整行复制到工作簿的下一页，也就是下个月。仅当组合框值 = 否时，才应通过 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

您只需要复制每一行 - 您正在复制整个行 block

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