根据条件复制列时出现问题

Question

我只想复制C和E列的值，但它也要复制D。

我已经编写了一个代码，当E值介于0到60之间时，它将复制“ REF”表中的C列及其对应的E列元素。然后将其复制到“ Cost”表中。但是它也在复制C，D和E值。请帮我解决问题。附上以下代码

Private Sub CommandButton1_Click()

lastRow = Worksheets("REF").Range("E" & Rows.Count).End(xlUp).Row

For r = 2 To lastRow

    If Worksheets("REF").Range("E" & r).Value <= 60 And Worksheets("REF").Range("E" & r).Value >= 0 Then
    
        Worksheets("REF").Range("C" & r & ":E" & r).Copy
        Worksheets("Cost").Activate
        lastRowSheet1 = Worksheets("Cost").Range("C" & Rows.Count).End(xlUp).Row
        Worksheets("Cost").Range("C" & lastRowSheet1 + 1).Select
        ActiveSheet.Paste
        End If
        Next r

End Sub

有关数据，请参阅图片

单击按钮后，将从最近打印的下一个单元格开始打印

Answer 1

使用条件复制单元格

提示

• 使用Option Explicit。
• 避免使用Activate和Select以及它们的各种样式。
• 使用变量。

快速修复

Option Explicit

Private Sub CommandButton1_Click()
    
    ' Define workbook.
    Dim wb As Workbook
    Set wb = ThisWorkbook
    ' Define worksheets.
    Dim src As Worksheet
    Set src = wb.Worksheets("REF")
    Dim tgt As Worksheet
    Set tgt = wb.Worksheets("Cost")
    ' Define last rows.
    Dim srcLastRow As Long
    srcLastRow = src.Range("E" & src.Rows.Count).End(xlUp).Row
    Dim tgtLastRow As Long
    tgtLastRow = tgt.Range("C" & src.Rows.Count).End(xlUp).Row
    
    Dim r As Long
    Dim NewRow As Long
    NewRow = tgtLastRow
    
    For r = 2 To srcLastRow
        If src.Range("E" & r).Value >= 0 And src.Range("E" & r).Value <= 60 Then
            NewRow = NewRow + 1
            src.Range("C" & r).Copy tgt.Range("C" & NewRow)
            src.Range("E" & r).Copy tgt.Range("D" & NewRow) ' Not sure if D or E
        End If
    Next r
    
End Sub