根據幾個條件將一個特定行從一張表複製到另一張

Question

我想根據我感興趣的4列中的一列是否大於0來複制整行。我是VBA的新手，並嘗試使用以下代碼它似乎並不奏效。

Sub MyViewCopy() 
    Set sh = Sheets("XyNewSheet") 
    RowCount = 0 
    lr2 = 0 
    For Each rw In sh.Rows 
     If (
     (Cells(rw.Row, 10).Value > 0) Or (Cells(rw.Row, 12).Value > 0) 
     Or 
     (Cells(rw.Row, 14).Value > 0) Or (Cells(rw.Row, 16).Value > 0) 
     Or 
     (Cells(rw.Row, 18).Value > 0) 
     ) Then 
     Rows(rw).Copy Destination:=Sheets("MyView").Range("A" & lr2 + 1) 
     lr2 = Sheets("MyView").Cells(Rows.Count, "A").End(xlUp).Row 

     RowCount = RowCount + 1 
    End If 
    Next rw 
    MsgBox (RowCount) 
End Sub 

Answer 1

嘗試削減在列J，L，N，P和R.

Option Explicit 

Sub MyViewCopy() 
    Dim r As Long, rc As Long, mxr As Long 

    With Worksheets("XyNewSheet") 
     mxr = Application.Max(.Cells(.Rows.Count, "J").End(xlUp).Row, _ 
           .Cells(.Rows.Count, "L").End(xlUp).Row, _ 
           .Cells(.Rows.Count, "N").End(xlUp).Row, _ 
           .Cells(.Rows.Count, "P").End(xlUp).Row, _ 
           .Cells(.Rows.Count, "R").End(xlUp).Row) 
     For r = 1 To mxr 
      If .Cells(r, "J").Value2 > 0 Or .Cells(r, "L").Value2 > 0 Or _ 
       .Cells(r, "N").Value2 > 0 Or .Cells(r, "P").Value2 > 0 Or _ 
       .Cells(r, "R").Value2 > 0 Then 
       .Rows(r).Copy Destination:=Worksheets("MyView").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) 
       rc = rc + 1 
      End If 
     Next r 
    End With 

    MsgBox (rc) 
End Sub 

你上或陳述包圍檢查，以使行與實際值的行是不必要的。只有當你想將And和Or組合在一起時纔有必要。