Copiar rangos en una sola columna

Me gaste algunos minutos, peor es con mucho agrado.
Espero la macro que hice te sirve. Solo tengo el rnago E1:H10, pero creo qu e solo debes cambiar el for K=1 to n donde n es el numero de columnas. Que vas a usar ahora.
Sub PREGUNTA03()
    Sheets("PREGUNTA03").Select
    ActiveCell.SpecialCells(xlLastCell).Select
    V_FIL = ActiveCell.Row
    V_RAN = "A1:A" & Trim(Str(V_FIL))
    V_FIL1 = 2
    For K = 1 To 4    ' Este los debs cambiar por el numero de columnas
        Range("E1").Select
        ActiveCell.Offset(0, K - 1).Select
        ActiveCell.Range(V_RAN).Select
        Selection.Copy
        If K >= 2 Then
            V_FIL1 = V_FIL1 + V_FIL
        End If
        V_RAN2 = "B" & Trim(Str(V_FIL1))
        Range(V_RAN2).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    Next K
    ActiveCell.SpecialCells(xlLastCell).Select
    V_FIL = ActiveCell.Row
    V_RAN = "A1:A" & Trim(Str(V_FIL))
    Range("A2").Select
    ActiveCell.Value = 1
    ActiveCell.Range(V_RAN).Select
    Selection.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
        Step:=1, Stop:=10000, Trend:=False
    Range("A1").Select
    Selection.CurrentRegion.Select
    Selection.Name = "DATOS"
    ActiveWorkbook.Worksheets("PREGUNTA03").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("PREGUNTA03").Sort.SortFields.Add _
        Key:=Range("B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("PREGUNTA03").Sort
        .SetRange Range("DATOS")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("B1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, -1).Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.ClearContents
    Range("A1").Select
    Selection.CurrentRegion.Select
    Selection.Name = "DATOS"
    ActiveWorkbook.Worksheets("PREGUNTA03").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("PREGUNTA03").Sort.SortFields.Add _
        Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("PREGUNTA03").Sort
        .SetRange Range("DATOS")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1").Select
End Sub