vba - 如果单元格小于数字，则将整行移动到另一张工作表

Question

我有五列:A 到 G。

1.如果列 G > 0 但小于 0.03，我正在尝试将行复制到“Sheet3”。

2.如果第 3 列 > .03 但小于 0.04，我想将行复制到“Sheet4”。

3.如果列 G > .04，则将行复制到“Sheet5”。

Answer 1

您的代码可能看起来像这样。

Sub ConditionalCopy()

'set cells in position on target sheets
Sheets("Sheet3").Activate
Range("A2").Select
Sheets("Sheet4").Activate
Range("A2").Select
Sheets("SHeet5").Activate
Range("A2").Select

'go to sheet with data
Sheets("Sheet1").Activate
'Assuming headers in Row 1 and data starts in row 2
Range("A2").Select

'Loop through rows until empty cell ( end of data )
Do While ActiveCell.Value <> ""

If Range("G" & ActiveCell.Row).Value > 0 And Range("G" & ActiveCell.Row).Value < 0.3 Then
    ActiveCell.EntireRow.Copy
    Sheets("Sheet3").Activate
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        ActiveCell.Offset(1, 0).Select
    Sheets("Sheet1").Activate
End If

If Range("C" & ActiveCell.Row).Value > 0.03 And Range("C" & ActiveCell.Row).Value < 0.04 Then
    ActiveCell.EntireRow.Copy
    Sheets("Sheet4").Activate
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        ActiveCell.Offset(1, 0).Select
    Sheets("Sheet1").Activate
End If

If Range("G" & ActiveCell.Row).Value > 0.04 Then
    ActiveCell.EntireRow.Copy
    Sheets("Sheet5").Activate
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        ActiveCell.Offset(1, 0).Select
    Sheets("Sheet1").Activate
End If

 ActiveCell.Offset(1, 0).Select

 Loop

 End Sub