копирования строк на новый лист VBA

Question

Я пытаюсь написать скрипт, который копирует строки из листа 1 к листу 2, , если значение первого столбца листа 1 больше или равно 10.

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

Это то, что вы пытаетесь?

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 

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

Это похоже на первый ответ, но некоторые различия. Вот некоторые примечания:

• Используйте для-каждого цикла, чтобы пройти диапазон (это не так быстро, как с помощью вариантного массива, но сохраняет простые вещи и предлагает более высокую скорость, чем для цикла
• Вы можете. хотите добавить проверку «If Isumeric (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