空白细胞宏

时间:2017-09-22 21:38:13

标签: vba

这是我的代码。我试图在一个范围内找到最后填充的行。然后将该数据作为公式复制到范围中的下一个空白行。最后再次复制最后填充的行并将其粘贴到第二个到最后一个填充的行作为值。简而言之,将最后一行/单元格中的公式向下移动一行,并将该数据保留在作为数字复制的位置。因此,当新数据进入文件时,公式会重新计算,并且我不会丢失先前计算的数据。希望这是有道理的。下面的代码运行但除了将数据粘贴为现有行中的值之外似乎没有做任何其他操作。我究竟做错了什么?

Sub Data Copy()

Dim myLastCell As Range
Set myLastCell = LastCell(Worksheets("YTD Metric Calculator").Range("E7:J76"))

Sheets("YTD Metric Calculator").Range("E7:J" & myLastCell.Row).Copy
Sheets("YTD Metric Calculator").Range("E7:J" & myLastCell.Row + 1).PasteSpecial Paste:=xlPasteFormulas
Sheets("YTD Metric Calculator").Range("E7:J" & myLastCell.Row).Copy
Sheets("YTD Metric Calculator").Range("E7:J" & myLastCell.Row + 1).PasteSpecial Paste:=xlPasteValues
'Retain Yesterday's YTD Metric Data

Function LastCell(r As Range) As Range

Dim LastRow&, lastCol%

On Error Resume Next

With r

LastRow& = .Cells.Find(What:="*", _
  SearchDirection:=xlPrevious, _
  SearchOrder:=xlByRows).Row

lastCol% = .Cells.Find(What:="*", _
  SearchDirection:=xlPrevious, _
  SearchOrder:=xlByColumns).Column

End With

Set LastCell = r.Cells(LastRow&, lastCol%)

End Function

1 个答案:

答案 0 :(得分:1)

Dim lstRow As Long
With ActiveSheet 'this should be set to actual sheet ie Worksheets("Sheet1")
    lstRow = .Cells(.Rows.Count, 4).End(xlUp).Row
    With .Range(.Cells(lstRow, 4), .Cells(lstRow, 10))
        .Offset(1).Formula = .Formula
        .Value = .Value
    End With
End With