Separate Every XX Rows Into New Sheet

I think this should do what you want

Sub x()

Dim r As Long

With Sheet1
    r = 1
    Do While .Cells(r, 1) <> vbNullString
        Sheets.Add after:=Sheets(Sheets.Count)
        .Cells(r, 1).Resize(5).Copy Sheets(Sheets.Count).Range("A1")
        r = r + 5
    Loop
End With

End Sub