选择性粘贴 - 仅限值

时间:2014-09-24 11:06:16

标签: excel-vba vba excel

我正在尝试创建一个审计跟踪数据库,并设法制定一些代码,将每一行带到第2页,但是我已经落到最后并且无法解决如何只粘贴值的问题?

这是我到目前为止的代码;任何帮助非常感谢

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim nxtRow As Integer, b As Boolean
    'Determine if change was to Column I (9)
   If Target.Column = 9 Then
        'If Yes, Determine if cell >= 1
       If IsError(Target.Value) Then
        b = True
    Else
        If Target.Value >= 1 Then
            b = True
        Else
            b = False
        End If
        End If
        If b Then
        'If Yes, find next empty row in Sheet 2
       nxtRow = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1
        'Copy changed row and paste into Sheet 2
       Target.EntireRow.Copy _
        Destination:=Sheets(2).Range("A" & nxtRow)
            End If
    End If
End Sub

由于 马特

2 个答案:

答案 0 :(得分:1)

要粘贴值,您可以复制到剪贴板,然后使用PasteSpecial方法,例如:

 Target.EntireRow.Copy
 Sheets(2).Range("A" & nxtRow).PasteSpecial Paste:=xlPasteValues

答案 1 :(得分:0)

这可能无法解决问题,但会改善您的代码 你打开一些If语句,但你没有关闭一些会使你的代码做你想做的事情。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim nxtRow As Integer, b As Boolean
    'Determine if change was to Column I (9)
   If Target.Column = 9 Then
        'If Yes, Determine if cell >= 1
       If IsError(Target.Value) Then ' You open this If but you don't close it
        b = True
       'if you don't close it here the next line (else) will be the else of this if
       End If 
   Else
        If Target.Value >= 1 Then
            b = True
        Else
            b = False
        End If
      'this line had an else if as well. which would just stop your main if statement
        If b = True Then 
        'you say 'if b then' on the line above, which basically does nothing
        'If you want to check if b = True for example, do what I did above

        'If Yes, find next empty row in Sheet 2
             nxtRow = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1
            'Copy changed row and paste into Sheet 2
            Target.EntireRow.Copy _
            Destination:=Sheets(2).Range("A" & nxtRow)
        End If
    End If
End Sub