Please attempt the next option. It is assumed that A contains the range that needs to be processed. A column's content will be dropped into the resulting array in B:B, starting with B1:
Sub ExtractBeforeZero()
Dim sh As Worksheet, lastR As Long, arr, arrB0, i As Long, k As Long
Set sh = ActiveSheet
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
arr = sh.Range("A1:A" & lastR).Value2 'place the range in an array for faster processing
ReDim arrB0(1 To UBound(arr)) 'redim the array to keep the return of its maximum possible number of elements
k = 1
For i = 1 To UBound(arr)
If arr(i, 1) = 0 Then arrB0(k) = arr(i - 1, 1): k = k + 1
Next i
If k > 1 Then 'if at least a zero has been found:
ReDim Preserve arrB0(1 To k - 1) 'keep only the filled elements
'drop the resulted array:
sh.Range("B1").Resize(UBound(arrB0), 1).Value2 = Application.Transpose(arrB0)
Else
MsgBox "No zero could be found in the processed column..."
End If
End Sub