Get rid of all empty cells in a column without deleting

I'm trying to fix a macro that find all emty cells in a collumn and moves the value of the cell under up so that the spaces dissapear without moving any cells since I have formulas dependent on the cell references.

This is my code which delete the empty cells and shift up:

Sub delete_blanks()
    Dim wks As Worksheet
    Dim lastrow As Long
    Dim col As Long
    Set wks = ActiveSheet
    With wks
        col = .Range("K3").Column
        lastrow = .Cells.SpecialCells(xlCellTypeLastCell).Row

    .Range(.Cells(2, col), .Cells(lastrow, col)) _
    .Cells.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
    
    End With
End Sub

But is it any way to instead just move the values please describe

Another way to solve the problem using my delete code could be this:
http://www.excelforum.com/excel-gene...ml#post2554682