粘贴值而不清除现有公式

Question

我找到了一个很好用的代码，除了当值填充第二张表时，其他列中的公式被删除。无论如何，是否可以将值复制并粘贴到它们的特定单元格中而不干扰任何其他单元格？ 我正在将 sheet9 中的 6 个单元格 (BO-BT) 复制到 sheet11 中的 A-F，但它会清除 G 和 K 列中的公式。 我是一个非常热心的初学者，所以虽然我对 VBA 了解不多，但我很高兴能让 excel 屈服于我的意志。 ;)

Sub CopyMarketMakes()

Dim StatusCol As Range
Dim Status As Range
Dim PasteCell As Range

'You will need to adapt this code for your scenario - follow the STEPS below


'STEP1: Change the sheet name and range in the line of code below to match the sheet name
'and range holding the data that you want to copy rows from.
Set StatusCol = Sheet9.Range("bt2:bt14")

For Each Status In StatusCol

'STEP2: Change the sheet name and range in the lines of code below to match the sheet name
'and cell that you want to copy your data to. You only need to specify one cell -
'the first cell you will copy to.
    If Sheet11.Range("A11") = "" Then
        Set PasteCell = Sheet11.Range("A11")
    Else
'STEP3: In the line of code below, the range should refer to your first column heading
        Set PasteCell = Sheet11.Range("A10").End(xlDown).Offset(1, 0)
    End If
'STEP4: I have included three ways of copying the data. To use one of the methods, delete
'the apostrophe before the words IF Status at the beginning of the line.
'You can only use one of the options.  The third option is currently active.

'This one was used in the video, but will only work if your criteria is in column 5
'and you have five cells per record
    If Status = "m" Then Status.Offset(0, -5).Resize(1, 66).Copy PasteCell

'This one copies the entire row - right across the worksheet
    'If Status = "Over budget" Then Status.EntireRow.Copy PasteCell

'This one only copies the relevant cells, rather than the entire row and it doesn't
'matter which row contains the criteria or how many cells you need to copy.
'It won't work, however, if you have blank cells in your data.
    'If Status = "Over budget" Then Range(Status.End(xlToLeft), Status.End(xlToRight)).Copy PasteCell
Next Status
        
End Sub

虽然我花了很多时间谷歌搜索来获得我自己的答案，但我认为可能有用的几件事却没有。

Answer 1

像这样：

Sub CopyMarketMakes()
   
    Dim Status As Range, PasteCell As Range

    If Sheet11.Range("A11") = "" Then
        Set PasteCell = Sheet11.Range("A11")
    Else
        Set PasteCell = Sheet11.Cells(Rows.count, "A").End(xlUp).offset(1)
    End If

    For Each Status In Sheet9.Range("BT2:BT14").Cells
        If Status = "m" Then 
            PasteCell.Resize(1, 6).value = Status.Offset(0, -5).Resize(1, 6).Value 
            Set PasteCell = PasteCell.Offset(1) 'next row down
        End If
    Next Status         
End Sub