將行復制到新工作表VBA

Question

我正在嘗試編寫一個腳本，如果Sheet 1的第一列的值大於或等於10，則將一行從Sheet 1復制到Sheet 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

Answer 1

這與第一個答案類似，但有一些差異。 這里有一些注意事項：

• 使用for-each循環遍歷一個范圍（它沒有使用變量數組那么快，但保持簡單並提供比for循環更快的速度。
• 您可能需要在值檢查之前添加“If IsNumeric（cell）”檢查。
• 不要使用select - 你不需要，它浪費資源。
• 最好使用A中使用的最后一個單元格然后使用的范圍。

這是代碼：

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

Answer 2

試試這個：它會是最快的，因為它不依賴於選擇，而是依賴於通過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

這是我運行的測試用例：

之前

后

Answer 3

這是你在嘗試什么？

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