将行复制到新工作表 VBA

copy rows to a new worksheet VBA

提问by user1296160

I am trying to write a script which copies a row from Sheet 1 to Sheet 2, if the value for the first column of Sheet 1 is greater or equal to 10.

我正在尝试编写一个脚本，如果工作表 1 的第一列的值大于或等于 10，则将行从工作表 1 复制到工作表 2。

Sub Macro1()

Cells(1, 1).Select
For i = 1 To ActiveCell.SpecialCells(xlLastCell).Row

    Cells(i, 1).Select

    If ActiveCell.Value >= 10 Then
        Rows(ActiveCell.Row).Select

        Rows(i & ":").Select
        Selection.Copy

        Sheets("Sheet2").Select
        ActiveSheet.Paste

        Sheets("Sheet1").Select

     End If

Next i

End Sub

回答by aevanko

This is similar to the first answer, but a few differences. Here's some notes:

这与第一个答案相似，但有一些不同。这里有一些注意事项：

• Use a for-each loop to go through a range (it's not as fast as using a variant array, but keeps things simple and offers better speed than a for loop.
• You may want add a "If IsNumeric(cell)" check before the value check.
• Don't use select - you don't need to and it wastes resources.
• Better to use the last cell used in A then the used range.

• 使用 for-each 循环遍历一个范围（它不像使用变体数组那么快，但保持简单并提供比 for 循环更好的速度。
• 您可能需要在值检查之前添加“If IsNumeric(cell)”检查。
• 不要使用 select - 您不需要，而且会浪费资源。
• 最好使用 A 中使用的最后一个单元格，然后使用使用的范围。

Here is the code:

这是代码：

Sub CopyRows()

Dim cell As Range
Dim lastRow As Long, i As Long

lastRow = Range("A" & Rows.Count).End(xlUp).Row
i = 1

For Each cell In Sheets(1).Range("A1:A" & lastRow)
    If cell.Value >= 10 Then
        cell.EntireRow.Copy Sheets(2).Cells(i, 1)
        i = i + 1
    End If
Next

End Sub

回答by ja72

Try this: It would be the fastest because it does not depend on selection, but on direct manipulation of data through VBA

试试这个：这将是最快的，因为它不依赖于选择，而是通过 VBA 直接操作数据

Sub CopyRows()
    Dim r_src As Range, r_dst As Range

    ' Pick 1st row and column of table
    Set r_src = Sheets("Sheet1").Range("B4")
    Set r_dst = Sheets("Sheet2").Range("B4")

    Dim i As Integer, j As Integer
    Dim N_rows As Integer, N_cols As Integer

    'Find the size of the data
    N_rows = CountRows(r_src)
    N_cols = CountColumns(r_src)

    'Resize source range to entire table
    Set r_src = r_src.Resize(N_rows, N_cols)

    Dim src_vals() As Variant, dst_vals() As Variant
    'Get all the values from source
    src_vals = r_src.Value2

    ReDim dst_vals(1 To N_rows, 1 To N_cols)
    Dim k As Integer
    k = 0
    For i = 1 To N_rows
        ' Check first column
        If Val(src_vals(i, 1)) >= 10 Then
            ' Increment count
            k = k + 1
            ' Copy row values
            For j = 1 To N_cols
                dst_vals(k, j) = src_vals(i, j)
            Next j
        End If
    Next i
    ' Bring rows back into destination range
    If k > 0 Then
        r_dst.Resize(k, N_cols).Value2 = dst_vals
    End If
End Sub

Public Function CountRows(ByRef r As Range) As Integer
    CountRows = r.Worksheet.Range(r, r.End(xlDown)).Rows.Count
End Function
Public Function CountColumns(ByRef r As Range) As Integer
    CountColumns = r.Worksheet.Range(r.End(xlToRight), r).Columns.Count
End Function

Here is a test case I run:

这是我运行的测试用例：

Before

前

After

后

回答by Siddharth Rout

Is this what you are trying?

这是你正在尝试的吗？

Option Explicit

Sub Sample()
    Dim wsI As Worksheet, wsO As Worksheet
    Dim LastRow As Long, i As Long, j As Long

    Set wsI = Sheets("Sheet1")
    Set wsO = Sheets("Sheet2")

    LastRow = wsI.Range("A" & Rows.Count).End(xlUp).Row

    j = 1

    With wsI
        For i = 1 To LastRow
            If Val(Trim(.Range("A" & i).Value)) >= 10 Then
                wsI.Rows(i).Copy wsO.Rows(j)
                j = j + 1
            End If
        Next i
    End With
End Sub