Excel VBA merge many columns into one on separate rows

Question

I have a large array of cells in multiple columns that need to be combined into one large column with a new row for each cell. I do NOT want to merge the contents of any cells.

Answer 1

The following macro could probably be easily modified to deal with a varying number of starting columns. Also, I only need each cell displayed once in the final column created (do not need duplicates.) I have no VBA experience however. Any help would be greatly appreciated.

---

Sub Macro1() Dim range As range Dim i As Integer

Dim RowCount As Integer Dim ColumnCount As Integer Dim sheet As worksheet Dim tempRange As range Dim valueRange As range Dim insertRange As range

Set range = Selection 
RowCount = range.Rows.Count 
ColumnCount = range.Columns.Count 
For i = 1 To RowCount 
    Set sheet = ActiveSheet 

    Set valueRange = sheet.range("A" & (((i - 1) * 4) + 1), "E" & (((i - 1) * 4) + 1)) 

    Set tempRange = sheet.range("A" & (((i - 1) * 4) + 2), "E" & (((i - 1) * 4) + 2)) 
    tempRange.Select 
    tempRange.Insert xlShiftDown 
    Set insertRange = Selection 
    insertRange.Cells(1, 1) = valueRange.Cells(1, 1) 
    insertRange.Cells(1, 2) = valueRange.Cells(1, 3) 
    valueRange.Cells(1, 3) = "" 

    Set tempRange = sheet.range("A" & (((i - 1) * 4) + 3), "E" & (((i - 1) * 4) + 3)) 
    tempRange.Select 
    tempRange.Insert xlShiftDown 
    Set insertRange = Selection 
    insertRange.Cells(1, 1) = valueRange.Cells(1, 1) 
    insertRange.Cells(1, 2) = valueRange.Cells(1, 4) 
    valueRange.Cells(1, 4) = "" 

    Set tempRange = sheet.range("A" & (((i - 1) * 4) + 4), "E" & (((i - 1) * 4) + 4)) 
    tempRange.Select 
    tempRange.Insert xlShiftDown 
    Set insertRange = Selection 
    insertRange.Cells(1, 1) = valueRange.Cells(1, 1) 
    insertRange.Cells(1, 2) = valueRange.Cells(1, 5) 
    valueRange.Cells(1, 5) = "" 

Next i 

End Sub