Pasted

Sub MoveRangeToColumn()
''moves a block of cells into a single column
 
Dim srcRange As Range
Dim dstRange As Range
Dim ic As Integer
Dim ir As Integer
Dim cel As Range
Dim numCells As Integer
Dim ws As Worksheet
Dim numRows As Integer
Dim numCols As Integer
Dim newColumn As Range
Dim newColCount As Integer
 
 
On Error Resume Next
 
''have the user select the range of cells to be stacked
Set srcRange = Application.InputBox(Title:="Source Range", Prompt:="Select the source range to stack. Do not include headers.", Type:=8)
On Error GoTo 0
 
'Test for cancel.
If srcRange Is Nothing Then Exit Sub
 
'Test for single-cell selection.
'Remove comment character if single-cell selection is okay.
If srcRange.Rows.Count = 1 Then
    MsgBox "You’ve selected only one cell." & "Please select multiple contiguous cells.", vbOKOnly
Exit Sub
 
End If
 
MsgBox srcRange.Address
''have the user select the first cell of the destination range
Set dstRange = Application.InputBox(Title:="Source Range", Prompt:="Please select the first cell of the destination column. Select one cell only.", Type:=8)
On Error GoTo 0
 
'Test for cancel.
If dstRange Is Nothing Then Exit Sub
 
''test if the user has selected more than one cel
If dstRange.Rows.Count > 1 Then
    MsgBox "You’ve selected more than one cell." & "Please select only one cells", vbOKOnly
Exit Sub
 
End If
MsgBox dstRange.Address
 
''Set srcRange = ActiveSheet.Range("E4:J12")
''Set dstRange = ActiveSheet.Range("N4")
numCells = srcRange.Cells.Count
numRows = srcRange.Rows.Count
numCols = srcRange.Columns.Count
newColCount = 1
 
''MsgBox numCells & "," & numRows & "," & numCols
''Debug.Print srcRange.Item(1, 1).Address
 
For ic = 1 To numCols
    For ir = 1 To numRows
        dstRange(newColCount, 1).Value = srcRange.Cells(ir, ic).Value
        Debug.Print dstRange(newColCount, 1).Value
        newColCount = newColCount + 1
    Next ir
Next ic
 
    
 
 
End Sub