[英]Copy row from one sheet to another based on criteria in a column
This workbook is setup for a userform to enter PO information so it can be added to a dynamic PO log.此工作簿是为用户表单设置的,用于输入 PO 信息,以便可以将其添加到动态 PO 日志中。 Once logged the user will close the userform and select a comboBox value Yes or No to indicate whether or not this PO should be deducted from the monthly budget.
登录后,用户将关闭用户表单和 select 和 comboBox 值 Yes 或 No 以指示是否应从每月预算中扣除此 PO。
If the user selects No the entire row should be copied to the next page in the workbook, which is also the next month.如果用户选择否,则应将整行复制到工作簿的下一页,也就是下个月。 This should happen via a Worksheet Selection_Change Event only if the comboBox value = No.
仅当 comboBox 值 = 否时,才应通过 Worksheet Selection_Change 事件发生这种情况。
If the user selects Yes other formulas will add the value to the total deductions so it should be ignored by the loop.如果用户选择是,其他公式会将值添加到总扣除额中,因此循环应该忽略它。
The pages in this workbook are exactly the same, so the range for the second month will be the same as the first month C14:H14, which again dynamically updates depending on how many NO values are selected.此工作簿中的页面完全相同,因此第二个月的范围将与第一个月的 C14:H14 相同,后者再次根据选择的 NO 值的数量动态更新。
I am having trouble finding only No values and copying the row C14:H14 to the next available row in the next worksheet.我无法仅找到 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
This code copies the last two data points and ignores the condition.此代码复制最后两个数据点并忽略条件。 It will copy Yes and No if they are mixed throughout the data set.
如果它们在整个数据集中混合,它将复制 Yes 和 No。
You only need to copy each row - you're copying a whole block of rows instead您只需要复制每一行 - 您正在复制整个行块
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.