Ahh, moving goalposts again.
Try these two (only run blah, it calls the other):
Sub blah()
Set mydata = Sheets("Sheet1").Range("A1:A" & Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row)
Set Destn = Sheets("Sheet2").Range("A1")
mydatavals = mydata.Value
Count = 1: StartBlock = 1
For i = 1 To UBound(mydatavals) - 1
If mydatavals(i, 1) = mydatavals(i + 1, 1) Then
Count = Count + 1
Else
MoveStuff mydata.Cells(StartBlock, 1).Resize(Count, 9), Destn
Set Destn = Destn.Offset(8)
StartBlock = StartBlock + Count: Count = 1
End If
Next i
MoveStuff mydata.Cells(StartBlock, 1).Resize(Count, 9), Destn
End Sub
Sub MoveStuff(SourceRange, DestnRange)
DestnRange.Resize(8, 1).Value = SourceRange.Cells(1).Value
Intersect(SourceRange, SourceRange.Offset(, 1)).Copy
DestnRange.Offset(, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
End Sub
(No clearing of the destination cells.)