Search code examples
excelvbacopypaste

Paste values without wiping out existing formulas


I found code that pastes values but when the values populate the second sheet, formulas in other columns are erased.

Is there any way of pasting the values into their specific cells without disturbing any other cells?

I am copying 6 cells (BO-BT) from sheet9 to A-F in sheet11, but it's wiping out the formulas in column G & K.

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

Solution

  • Like this:

    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