Making one long colum out of many

[×1]

Hi Excel experts!
I have 20 colums, each one is about 30 cells long, that are placed on the
worksheet one next to the other. It takes me a lot of time to copy and paste
them into one long colum. How can I do it faster?
Thanks,
Elad

 

[Wigi]

Hi

As I don't know where these columns are, I wrote a general procedure:


Sub longcolumn()

Dim rBegincell As Range

Set rBegincell = Selection.Cells(1)

Range(rBegincell, rBegincell.End(xlDown)).Cut Range("A" &
Rows.Count).End(xlUp).Offset(1)

End Sub


Select the first cell of a small column, and execute the macro (you can
assign a shortcut key to it if you want).

The code will move the cells below the last cell used in column A.

 

[Don Guillett]

This should do it for you.

Sub copyallcolstocolA()
For i = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
cl = Cells(Rows.Count, i).End(xlUp).Row
dlr = Cells(Rows.Count, 1).End(xlUp).Row + 1
Range(Cells(1, i), Cells(cl, i)).Copy Cells(dlr, 1)
Next i
End Sub

 

[Ragdyer]

For a function approach:

Say your datalist was from A1 to T30,
enter this formula anywhere outside the data range and copy down as needed:

=INDEX($A$1:$T$30,MOD(ROWS($1:1)-1,30)+1,ROWS($1:30)/30)

To modify this formula to a different range,
of course change the Index range,
BUT *only* change the number of rows (30) in the 3 places in the formula.
The columns will automatically increment after reaching the referenced row
number.

 

[Ragdyer]

I should revise the revision instructions.

The 30 is the number of rows in the indexed range, *NOT* the row number.

So, to change to a range of J32 to HG148, use:

=INDEX($J$32:$HG$148,MOD(ROWS($1:1)-1,117)+1,ROWS($1:117)/117)

 

[Lars-Åke Aspelin]

I should revise the revision instructions.

The 30 is the number of rows in the indexed range, *NOT* the row number.

So, to change to a range of J32 to HG148, use:

=INDEX($J$32:$HG$148,MOD(ROWS($1:1)-1,117)+1,ROWS($1:117)/117)

The OP wrote:

"I have 20 colums, each one is about 30 cells long,...."

To me that does not imply that all columns have equal length, just
that 30 is a typical length of the columns.
So column1 could hold 28 cells of data, column 2 could hold 33, and so
on.

If that is the case we will have to find another formula that takes
care of the different column lengths so that there will not be any
"gaps" in the new, long, column.

Lars-Åke

 

[Gord Dibben]

Sub OneColumnV2()
''''''''''''''''''''''''''''''''''''''''''
'Macro to copy columns of variable length'
'into 1 continous column in a new sheet '
'Modified 17 FEb 2006 by Bernie Dietrick
''''''''''''''''''''''''''''''''''''''''''
Dim iLastcol As Long
Dim iLastRow As Long
Dim jLastrow As Long
Dim ColNdx As Long
Dim ws As Worksheet
Dim myRng As Range
Dim ExcludeBlanks As Boolean
Dim myCell As Range

ExcludeBlanks = (MsgBox("Exclude Blanks", vbYesNo) = vbYes)
Set ws = ActiveSheet
iLastcol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
On Error Resume Next

Application.DisplayAlerts = False
Worksheets("Alldata").Delete
Application.DisplayAlerts = True

Sheets.Add.Name = "Alldata"

For ColNdx = 1 To iLastcol

iLastRow = ws.Cells(ws.Rows.Count, ColNdx).End(xlUp).Row

Set myRng = ws.Range(ws.Cells(1, ColNdx), _
ws.Cells(iLastRow, ColNdx))

If ExcludeBlanks Then
For Each myCell In myRng
If myCell.Value <> "" Then
jLastrow = Sheets("Alldata").Cells(Rows.Count, 1) _
.End(xlUp).Row
myCell.Copy
Sheets("Alldata").Cells(jLastrow + 1, 1) _
.PasteSpecial xlPasteValues
End If
Next myCell
Else
myRng.Copy
jLastrow = Sheets("Alldata").Cells(Rows.Count, 1) _
.End(xlUp).Row
myCell.Copy
Sheets("Alldata").Cells(jLastrow + 1, 1) _
.PasteSpecial xlPasteValues
End If
Next

Sheets("Alldata").Rows("1:1").entirerow.Delete

ws.Activate
End Sub


Gord Dibben MS Excel MVP

 

[Ragdyer]

I read it that on different occasions (... import sessions ?), the number of
rows may vary, hence the reason I included revision instructions.

But, you may be right.

Let's see if the OP responds.

 

[Don Guillett]

Hey Guys, I tested my simple little macro and it worked just fine...

 

[Ragdyer]

I don't see anybody making accusations that say it didn't!<bg>

 

[Hankjam]

Hello Chaps

This is something I need to do and so I've copied your suggestions(1)
and will take them to work today and try them through and get back
you.

It's just great the way people share their knowledge.

Thank you

Aj
<B6>

(1) don't have Agent at work and GG is....

 

[×1]

Thank you guys very very much! I was able to save so much time in my work
today you wouldn't beileve!

 

[Hankjam]

<snipped>

Back from work and they all worked a treat after some realignment of
blocks!

Many thanks

Aj
<B6>

 

[Yoyo]

Excellent post! Thanks for sharing this macro - many's the time I wanted to
be able to do this. I've created a small workbook called "Useful macros.xls"
to document this and any others I find or create.

 

[Yoyo]

Great post! Thanks for sharing this macro - many's the time I wanted to be
able to do this. I've created a small workbook called "Useful macros.xls" to
document this and other macros I find or create.

 

[Yoyo]

Great post! Thanks for sharing this macro - many's the time I wanted to be
able to do this. I've created a small workbook called "Useful macros.xls" to
document this and other macros I find or create.

 

[Yoyo]

Great post! Thanks for sharing this macro - many's the time I wanted to be
able to do this. I've created a small workbook called "Useful macros.xls" to
document this and other macros I find or create.

 

[Yoyo]

Apologies to all for duplicate posts below - I just followed Microsoft's
instructions and "tried again" when it reported a failure to post. ;-)
Sheesh!

 

[Gord Dibben]

Thanks

Bernie will be pleased you think highly of his code.


Gord