我只想复制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
有关数据,请参阅图片
单击按钮后,将从最近打印的下一个单元格开始打印
答案 0 :(得分: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