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

如果符合条件，则Vba复制并粘贴特定单元格

1 个答案: