求助：Excel VBA无法实现仅粘贴值操作

我明白你现在的困扰——原来的VBA代码是整行复制粘贴，没法实现只粘贴值的需求。咱们先看看你原来的代码，再一步步调整：

你原来的代码 #

Private Sub CommandButton5_Click()
'Komanda rinkti duomenis
a = Worksheets("Lapas1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To a
    If Worksheets("lapas1").Cells(i, 3).Value = Range("K5") Then
        Worksheets("lapas1").Rows(i).Copy
        Worksheets("Sàskaita-Faktûra").Activate
        b = Worksheets("Sàskaita-Faktûra").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("Sàskaita-Faktûra").Cells(b + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("lapas1").Activate
    End If
Next
Application.CutCopyMode = False
Worksheets("Sàskaita-Faktûra").Activate
Range("K5").Activate
End Sub

问题所在 #

原来的代码用了Copy+Paste，这会把单元格的格式、公式甚至条件格式都带过去；而且频繁用Activate和Select不仅容易出错，还会拖慢代码运行速度。

修改后的代码（两种方案可选） #

方案1：用PasteSpecial实现仅粘贴值

这个方案保留你原来的复制逻辑，把粘贴改成PasteSpecial明确指定仅粘贴值：

Private Sub CommandButton5_Click()
'Komanda rinkti duomenis
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim lastRowSource As Long, lastRowTarget As Long
Dim i As Long

' 提前定义工作表对象，避免反复引用
Set wsSource = ThisWorkbook.Worksheets("Lapas1")
Set wsTarget = ThisWorkbook.Worksheets("Sàskaita-Faktûra")

lastRowSource = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row

For i = 2 To lastRowSource
    ' 明确指定Range("K5")所在的工作表，避免歧义
    If wsSource.Cells(i, 3).Value = wsTarget.Range("K5").Value Then
        wsSource.Rows(i).Copy
        lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, 1).End(xlUp).Row
        ' 直接用目标单元格执行PasteSpecial，无需Activate和Select
        wsTarget.Cells(lastRowTarget + 1, 1).PasteSpecial Paste:=xlPasteValues
    End If
Next i

Application.CutCopyMode = False
' 直接选中目标单元格，无需激活工作表
wsTarget.Range("K5").Select
End Sub

方案2：直接赋值（更高效，无需剪贴板）

如果不需要保留剪贴板内容，直接把源行的值赋值给目标行，速度更快也更稳定：

Private Sub CommandButton5_Click()
'Komanda rinkti duomenis
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim lastRowSource As Long, lastRowTarget As Long
Dim i As Long

Set wsSource = ThisWorkbook.Worksheets("Lapas1")
Set wsTarget = ThisWorkbook.Worksheets("Sàskaita-Faktûra")

lastRowSource = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row

For i = 2 To lastRowSource
    If wsSource.Cells(i, 3).Value = wsTarget.Range("K5").Value Then
        lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, 1).End(xlUp).Row
        ' 直接将源行的值赋值到目标行，仅复制值
        wsTarget.Rows(lastRowTarget + 1).Value = wsSource.Rows(i).Value
    End If
Next i

wsTarget.Range("K5").Select
End Sub

关键修改说明 #

• 提前定义工作表对象，避免反复写Worksheets("xxx")，代码更清晰也不容易出错
• 去掉了所有Activate和Select操作，直接引用工作表和单元格，这是VBA优化的常用技巧
• 方案1用PasteSpecial Paste:=xlPasteValues明确指定仅粘贴值；方案2直接赋值，跳过剪贴板，效率更高

内容的提问来源于stack exchange，提问作者Darius B.