Filling empty cells

Hello!

I had to add a little code to another macro to make it fill empty cells with a specified number (973).

I found almost ready code and modified it to fit my needs.

Currently it looks like that:

Sub puste()

  Dim Area As Range, LastRow As Long
  On Error Resume Next
  LastRow = Cells.Find(What:="*", SearchOrder:=xlRows, _
               SearchDirection:=xlPrevious, _
               LookIn:=xlFormulas).Row
  For Each Area In ActiveCell.EntireColumn(1).Resize(LastRow). _
               SpecialCells(xlCellTypeBlanks).Areas
    Area.Value = "973"
  Next
End Sub

I have 2 questions:
1. Is there an easier way to do it? Maybe a lot faster one.
2. What do I have to change to make it work on column A instead of current selection?

Thanks for all the tips!