1

I have a series of columns of data, each 15 rows deep. Column B is the column I want to move all other columns beneath in order. So the contents of column C gets cut and moved below that already in B and so on.

So far I have;

'Select a column
ActiveSheet.Range("B1", ActiveSheet.Range("B1").End(xlDown)).Select
'Cut
Selection.Cut
'Select cell at bottom of A
ActiveSheet.Range("a1").End(xlDown).Offset(1, 0).Select
'Paste
ActiveSheet.Paste

I need the loop to make it work, looping through all the columns from A to FN.

Thanks in advance.

Community
  • 1
  • 1
mhollander38
  • 775
  • 3
  • 11
  • 22
  • Sorry, I don't understand .... Do you want to move WHAT under WHAT? – Dr. belisarius Jan 31 '11 at 21:03
  • All other columns under Column B. So column C's data to under column B, column D's data to under column B, etc all the way up to column FN, so I am left with one long column B. – mhollander38 Jan 31 '11 at 21:05

3 Answers3

1
Dim col As Range

For Each col In Worksheets("Sheet1").Columns
    If (col.Column > 1 And col.Column < 171) Then
    Range(col.Rows(1), col.Rows(15)).Select
    Selection.Cut
    'Select cell at bottom of A
    ActiveSheet.Range("a1").End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste   'Paste
    End If
Next col
End Sub
Dr. belisarius
  • 60,527
  • 15
  • 115
  • 190
0

I think this will do what you describe. If not, perhaps you could explain a little more clearly?

Dim LastCol As Integer, c As Integer, r As Long
LastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
For c = 2 To LastCol
        If Cells(1, c) <> "" Then
            ActiveSheet.Range(Chr$(64 + c) & "1", ActiveSheet.Range(Chr$(64 + c) & "1").End(xlDown)).Select
            Selection.Cut
            ActiveSheet.Range("a1").End(xlDown).Offset(1, 0).Select
            ActiveSheet.Paste
        End If
Next c
lowlevel
  • 188
  • 3
  • 9
  • This brings up run time error 1004 for; ActiveSheet.Range(Chr$(64 + c) & "1", ActiveSheet.Range(Chr$(64 + c) & "1").End(xlDown)).Select It also only goes up to row Z, I need it to go to column FN, or idealy the last column containing data. – mhollander38 Jan 31 '11 at 21:21
  • This example just requires there to be something in every cell along the top of your spreadsheet to keep appending the column data to column A. You should be able to make it do what you want from this example... but yes, you will require it to go past column Z, which means a slightly different approach to stepping through the columns. – lowlevel Jan 31 '11 at 21:24
  • I'll add another answer in a minute with it working for out to column FN if you like... – lowlevel Jan 31 '11 at 21:33
  • You're welcome, this is a great community and I had some time to kill so why not! Take care – lowlevel Feb 01 '11 at 16:06
0
Sub go()
Dim LastCol As Integer, c As Integer, r As Long
LastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
For c = 2 To LastCol
        If Cells(1, c)  "" Then
            ActiveSheet.Range(ColumnLetter(c) & "1", ActiveSheet.Range(ColumnLetter(c) & "1").End(xlDown)).Select
            Selection.Cut
            ActiveSheet.Range("a1").End(xlDown).Offset(1, 0).Select
            ActiveSheet.Paste
        End If
Next c

End Sub

Function ColumnLetter(ColumnNumber As Integer) As String
  If ColumnNumber > 26 Then

    ' 1st character:  Subtract 1 to map the characters to 0-25,
    '                 but you don't have to remap back to 1-26
    '                 after the 'Int' operation since columns
    '                 1-26 have no prefix letter

    ' 2nd character:  Subtract 1 to map the characters to 0-25,
    '                 but then must remap back to 1-26 after
    '                 the 'Mod' operation by adding 1 back in
    '                 (included in the '65')

    ColumnLetter = Chr(Int((ColumnNumber - 1) / 26) + 64) & _
                   Chr(((ColumnNumber - 1) Mod 26) + 65)
  Else
    ' Columns A-Z
    ColumnLetter = Chr(ColumnNumber + 64)
  End If
End Function

Another approach, is to use the numbers directly, but I forget how to do that... Cheers!

-Stuart

lowlevel
  • 188
  • 3
  • 9