复制并粘贴值

Question

我有这个代码，但它复制公式，我只有值。 我对VBA不太了解。

Dim sh4 As Worksheet, sh5 As Worksheet, lr As Long, rng As Range 

Set sh4 = Sheets("Transfer_New") 
Set sh5 = Sheets("Closed_Loans") 
lr = sh4.Cells(Rows.Count, 1).End(xlUp).Row 
Set rng = sh4.Range("A2:A" & lr) 

Application.Cursor = xlHand 

iReply = MsgBox(Prompt:="Are you sure you want to transfer client to CLOSED_LOANS?", _ 
    Buttons:=vbYesNo, Title:="Document Production") 
     If iReply = vbYes Then 
      Application.Cursor = xlWait: rng.EntireRow.Copy sh5.Cells(Rows.Count, 1).End(xlUp)(2): Application.Cursor = xlNorthwestArrow      
     End If 
End Sub 

Answer 1

更改此：

If iReply = vbYes Then 
     Application.Cursor = xlWait: rng.EntireRow.Copy sh5.Cells(Rows.Count, 1).End(xlUp)(2): Application.Cursor = xlNorthwestArrow      
    End If 

为了这个（没有很好的理由 - 当然不是为了易读性/透明度 - 把多行代码在同一行（这是什么:分离器一样）

If iReply = vbYes Then 
     Application.Cursor = xlWait 
     rng.EntireRow.Copy sh5.Cells(Rows.Count, 1).End(xlUp)(2) 
     Application.Cursor = xlNorthwestArrow      
    End If 

然后改成这样：

Dim destRng as Range 
    Set destRng = sh5.Cells(Rows.Count, 1).End(xlUp).Offset(1,0) 
    If iReply = vbYes Then 
     Application.Cursor = xlWait 
     destRng.Value = rng.Value 
     Application.Cursor = xlNorthwestArrow      
    End If 

Answer 2

如果要粘贴值，试试这个：

rng.Entirerow.Copy: sh5.Cells(Rows.Count, 1).End(xlUp).Offset(1,0).PasteSpecial xlPasteValues 

我认为是发生了什么只有在你的代码失踪。