Automatically Filling In Data?

I'm simply inputting zeroes and ones down Column A. Basically, I either put a "0" or a "1" in A1, then A2, then A3, etc. However, I want to create a Macro that allows me to simply type in a string of 1's and 0's and it automatically takes each 1 and 0 and fills it in down the column. This website has the basic idea (Automatically Moving from Cell to Cell when Entering Data (Microsoft Excel)) but I need only one number per cell and for it to move down the column, not across the row. Here's what I have so far:

Sub SAMPLE()
Dim str As String
Dim x As Integer
Dim y As Integer
str = InputBox("Enter string")
y = 0
For x = 1 To Len(str) Step 4
ActiveCell.Offset(y, 0) = "'" & Mid(str, x, 4)
y = y + 1
Next
End Sub

*I can't get it to only break down into one number per cell down Column A. I think the Mid function or something needs to change.