2017-04-08 16 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

ブリリアント。ありがとうございました –

関連する問題