Public Sub CopyAreas()
Dim aRange As Range
Dim Destination As Range
Set Destination = Worksheets("Sheet3").Range("A1")
For Each aRange In Cells.SpecialCells(xlCellTypeConstants, xlNumbers).Areas
aRange.Copy Destination:=Destination
Set Destination = Destination.Offset(aRange.Rows.Count + 1)
Next aRange
End Sub