VBA pull first 4 digits until the bottom of the data

[psrs0810]

I need to setup vba to look at a sheet, call it sheet 1 and pull the first 4 digits (into sheet 2) until it gets to the bottom of sheet 1
Thanks

[mdmackillop]

Sub test()

Dim r1 As Range, r2 As Range
Set r1 = Sheet1.Columns(1).SpecialCells(2)
Set r2 = Sheet2.Range(r1.Address)
r2.FormulaR1C1 = "=LEFT(Sheet1!RC,4)*1"
With Sheet2.UsedRange.Columns(1)
    .Value = .Value
End With
End Sub