如果符合條件，則VBA復制並粘貼特定的單元格

Question

如果C列中的值大於0，我試圖復制並粘貼C至F每行中的單元格。請幫助謝謝！

Private Sub CommandButton2_Click()
Dim range1 As Range
Dim Cell As Object
Set range1 = Sheet1.Range("C8:C40")

For Each Cell In range1
    If IsEmpty(Cell) Then
        End If
    If Cell.Value > 0 Then
    Sheet1.range(C:F).Copy
    Sheet5.Select
    ActiveSheet.Range("A40").End(xlUp).Select
    Selection.Offset(1, 0).Select
    ActiveSheet.Paste
    End If
    Next
    End Sub

Answer 1

您需要設置要測試的行。

也不要使用.Activate或.Select它只會減慢代碼速度。

Private Sub CommandButton2_Click()
Dim range1 As Range
Dim Cell As Range
Set range1 = Sheet1.Range("C8:C40")

For Each Cell In range1
    If Cell.Value > 0 Then
        With Sheet1
            .Range(.Cells(Cell.Row,"C"),.Cells(Cell.Row,"F")).Copy Sheet5.Range("A40").End(xlUp).Offset(1, 0)
        End With
    End If
Next
End Sub

---

要僅使用值而不格式化，請執行以下操作：

.Range(.Cells(Cell.Row,"C"),.Cells(Cell.Row,"F")).Copy Sheet5.Range("A40").End(xlUp).Offset(1, 0)

至：

Sheet5.Range("A40").End(xlUp).Offset(1, 0).Resize(,4).Value = .Range(.Cells(Cell.Row,"C"),.Cells(Cell.Row,"F")).Value