Copy data from one sheet to another while skipping blanks and certain rows

Hi. I'm trying to copy data from one sheet to another, but I want it to skip blanks and a row that has data on it. I've attached my spreadsheet that I need help on.

I want o9:o12, o14:o17, o19:o22, o24:o27, and o29:o34 from Sheet1 to be moved to A8:A33 on Sheet 2. Those cells have a vlookup formula that makes the code below not work.

Rows 13, 18, 23, and 28 on Sheet1 need to be left out.

The data currently looks like this on Sheet1:
Cinnamon Apple Slices


Fresh Red Delicious Apple

On Sheet2, I want the data to look like below with no spaces between each menu item.

Cinnamon Apple Slices
Fresh Red Delicious Apple

Sub Copy_Stuff2()
Application.ScreenUpdating = False
Sheets("Sheet2").Range("A8:A33").ClearContents
With Sheets("Sheet1").Range("o9:o12, o14:o17, o19:o22, o24:o27, and o29:o34").SpecialCells(xlCellTypeConstants)
.Copy
Sheets("Sheet2").Range("A8").PasteSpecial xlPasteValues
'ClearContents 'Clear source data
End With
Application.CutCopyMode = True
Application.ScreenUpdating = True
End Sub