Sub CopyAreas()
Dim rng As range, rngDestination As range
Set rngDestination = Worksheets("Sheet1").range("A1")
For Each rng In cells.SpecialCells(xlCellTypeConstants, xlNumbers).Areas
rng.copy Destination:=rngDestination
Set rngDestination = rngDestination.offset(rng.Rows.count + 1)
Next rng
End Sub