Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement