Question

我有五列：A到G.

1.我正在尝试将行复制到＆＃34; Sheet3＆＃34;如果列G> 0但小于.03。

2.我想将行复制到＆＃34; Sheet4＆＃34;如果第3列是> .03但不到.04。

3.将行复制到＆＃34; Sheet5＆＃34;如果列G> 0.04。

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

Answer 2

使用数据循环遍历行并粘贴到其他工作表时，可以更好（和更快）地避免始终使用Activate 复制＆gt;＆gt;粘贴即可。此外，建议不要使用ActiveCell和Select，而应使用引用的Sheets，Cells和Range。例如，使用With Sheets("Sheet1")。

下面的代码将循环遍历所有数据行，直到LastRow包含G列中的数据，并检查哪些标准符合。然后它将它粘贴到相关的工作表，到＃34; Sheet3＆＃34;中的第一个空行。 /＆＃34; Sheet4＆＃34; /＆＃34; Sheet5＆＃34;，以防这些工作表中已有现有数据。

在我的代码中，我使用PasteSpecial xlValues仅粘贴值，但可以轻松修改。

注意：在你的帖子中，你没有提到当G列= .03或= .04时你做了什么。

代码

Option Explicit

Sub CopytoAnotherSheet()

Dim LastRow As Long, SrcRow   As Long

' mpdify "Sheet1" to your sheet's name where you hold your data
With Sheets("Sheet1")
    ' find last row with data in Column G
    LastRow = .Cells(.Rows.Count, "G").End(xlUp).Row

    ' loop through all rows, starting from 2nd rows (ususaly 1st row is the header row)
    For SrcRow = 2 To LastRow

        ' Cell in column G is > 0 and < 0.03
        If .Cells(SrcRow, 7).Value > 0 And .Cells(SrcRow, 7).Value < 0.03 Then
            .Cells(SrcRow, 7).EntireRow.Copy
            ' paste values to first empty row in Sheet3
            Sheets("Sheet3").Range("A" & Sheets("Sheet3").Cells(Sheets("Sheet3").Rows.Count, "G").End(xlUp).Row + 1).PasteSpecial xlValues
        Else
            ' Cell in column G is > 0.03 and < 0.04
            If .Cells(SrcRow, 7).Value > 0.03 And .Cells(SrcRow, 7).Value < 0.04 Then
                .Cells(SrcRow, 7).EntireRow.Copy
                ' paste values to first empty row in Sheet4
                Sheets("Sheet4").Range("A" & Sheets("Sheet4").Cells(Sheets("Sheet4").Rows.Count, "G").End(xlUp).Row + 1).PasteSpecial xlValues
            Else
                ' Cell in column G is > 0.04
                If .Cells(SrcRow, 7).Value > 0.04 Then
                    .Cells(SrcRow, 7).EntireRow.Copy
                    ' paste values to first empty row in Sheet5
                    Sheets("Sheet5").Range("A" & Sheets("Sheet5").Cells(Sheets("Sheet5").Rows.Count, "G").End(xlUp).Row + 1).PasteSpecial xlValues
                End If
            End If
        End If

    Next SrcRow
End With

End Sub

如果单元格小于数字

2 个答案:

代码