2017-04-08 30 views
0

我想選擇包含SUM公式的列。我想複製公式並只過去同一列中的值。但此代碼不會將公式更改爲值。任何想法我怎麼能解決這個問題?vba中的過去值

Sub Registrereren() 

Application.Calculation = xlCalculationManual 
Application.EnableEvents = False 
Application.ScreenUpdating = False 

On Error Resume Next 

Dim oWkSht As Worksheet 
Dim LastColumn As Long 
Dim c As Date 
Dim myCell As Range 
Dim LastRow As Long 

Sheets("Registration").Activate 


Set oWkSht = ThisWorkbook.Sheets("Registration") 
LastColumn = oWkSht.Range("A" & Columns.Count).End(xlToRight).Column 
LastRow = oWkSht.Range("C" & Rows.Count).End(xlUp).Row 

c = Date 

Set myCell = oWkSht.Range("1:1").Find(What:=c, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False, SearchOrder:=xlByColumns) 

If Not myCell Is Nothing Then 
    myCell.Offset(1, 0).Formula = "=New_Order!N2+New_Order!O2+New_Order!P2" 
    Range(myCell.Offset(1), Cells(LastRow, myCell.Column)).Select 
    Selection.FillDown 

    Range(myCell.Offset(1), LastRow).Select 
    Selection.Copy 
    Range(myCell.Offset(1), LastRow).PasteSpecial xlPasteValues 
End If 

Sheets("Main").Activate 

Application.Calculation = xlCalculationAutomatic 
Application.EnableEvents = True 
Application.ScreenUpdating = True 

End Sub 

回答

1

試試這個。 LastRow不是有效的範圍,因爲它只是一個行號。

Sub Registrereren() 

Application.Calculation = xlCalculationManual 
Application.EnableEvents = False 
Application.ScreenUpdating = False 

Dim oWkSht As Worksheet 
Dim LastColumn As Long 
Dim c As Date 
Dim myCell As Range 
Dim LastRow As Long 

Set oWkSht = ThisWorkbook.Sheets("Registration") 
LastColumn = oWkSht.Range("A" & Columns.Count).End(xlToRight).Column 
LastRow = oWkSht.Range("C" & Rows.Count).End(xlUp).Row 

c = Date 

Set myCell = oWkSht.Range("1:1").Find(What:=c, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False, SearchOrder:=xlByColumns) 

If Not myCell Is Nothing Then 
    With oWkSht.Range(myCell.Offset(1), oWkSht.Cells(LastRow, myCell.Column)) 
     .Formula = "=New_Order!N2+New_Order!O2+New_Order!P2" 
     .Value = .Value 
    End With 
End If 

Sheets("Main").Activate 

Application.Calculation = xlCalculationAutomatic 
Application.EnableEvents = True 
Application.ScreenUpdating = True 

End Sub 
+0

輝煌。謝謝 –