VBA Code to Count a group of '1' values

Hi,
I am working on a code that goes through a column of '1' and '0' values. The code needs to count the '1' values in the column if they are in adjacent rows. So essentially it need to loop through the entire column, when it gets to a value of '1' it starts counting until the next row is a '0' at which point the counter is written to the first blank row in another worksheet, then the loop should continue for the rest of the column repeating. I started both a Do...While loop and a For loop but neither seemed to work. Here they are;

Private Sub CommandButton1_Click()

Dim CellValue As String
Dim i As Long
Dim j As Long
Dim strResult As String
Dim endRow As Long
Dim dtCounter As Long

endRow = 5000
i = 1
dtCounter = 0

Do While i < endRow
dtCounter = 0
If ActiveSheet.Cells(i, 8).Value = 1 And ActiveSheet.Cells(i + 1, 8).Value = 1 Then
i = i + 1
dtCounter = dtCounter + 1
ElseIf ActiveSheet.Cells(i, 8).Value = 1 And ActiveSheet.Cells(i + 1, 8).Value = 0 Then
i = i + 1
ActiveSheet.Cells(i, 1).Value = dtCounter
Else
End If
i = i + 1
Loop
End Sub





Private Sub CommandButton2_Click()

Dim i As Long
Dim endRow As Long
Dim dtCounter As Long

For i = 1 To endRow
dtCounter = 0
If ActiveSheet.Cells(i, 8).Value = 1 And ActiveSheet.Cells(i + 1, 8).Value = 1 Then
dtCounter = dtCounter + 1
ElseIf ActiveSheet.Cells(i, 8).Value = 1 And ActiveSheet.Cells(i + 1, 8) = 0 Then
ActiveSheet.Cell(i, 1).Value = dtCounter
ElseIf ActiveSheet.Cells(i, 8).Value = 0 And ActiveSheet.Cells(i + 1, 8) = 0 Then
End If
Next i

End Sub




Any help would be appreciated,
Thanks!