transfer to single column

[bala06]

Dear Excel users

I would like to transfer my data from multiple columns to sinlge column.

The length of the columns is varies and it also contains gaps or some columns are empty.

Kindly adivce.

Many Thanks
Balaji

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG31May58
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Sheets("Sheet1").Range("A1").CurrentRegion
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        [COLOR="Navy"]If[/COLOR] Dn <> "" [COLOR="Navy"]Then[/COLOR]
            c = c + 1
            Sheets("sheet3").Range("A" & c) = Dn '[COLOR="Green"][B]Sheet3 = destination Sheet[/B][/COLOR]
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[bala06]

Dear Mick

Thanks for help.

It shows error in the line

" Sheets("sheet3").Range("A" & c) = Dn 'Sheet3 = destination Sheet"

many Thanks
Balaji

 

[MickG]

Make sure you have a sheet of that name.
If not the problem please show an example of your sheet and the approx size of the range.
NB:- To show sheet place a Border around each cell within the range to be copied ,to form a grid. Copy and paste range to the Thread.
Mick

 

[bala06]

Make sure you have a sheet of that name.
If not the problem please show an example of your sheet and the approx size of the range.
NB:- To show sheet place a Border around each cell within the range to be copied ,to form a grid. Copy and paste range to the Thread.
Mick

Dear Mick

It works.

Many Thanks
Balaji

 

[Peter_SSs]

Dear Mick

It works.

Many Thanks
Balaji

But it is not robust if the following is true:

The length of the columns is varies and it also contains gaps or some columns are empty.

For example, with the following layout, only the blue cells would get copied to Sheet3.

Excel Workbook
	A	B	C	D
1	gdg	gj		df
2	gsdf	gj		gfd
3	g	j
4		g		f
5				g
6	dfg			f
7	hfg			df
8	hfg			fg
9
Sheet1

Also, I think looping through each cell is a slow way to process this task.

Assuming ..
- your Data is on Sheet1
- data starts in column A
- Sheet3 exists and is where you want the results
.. then I would suggest trying this instead.

<font face=Courier New><br><br><SPAN style="color:#00007F">Sub</SPAN> AllColsToOne()<br>    <SPAN style="color:#00007F">Dim</SPAN> Cols <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, c <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> UR <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> wsD <SPAN style="color:#00007F">As</SPAN> Worksheet<br>    <br>    <SPAN style="color:#00007F">Set</SPAN> wsD = Sheets("Sheet3")<br>    wsD.Columns("A").ClearContents<br>    <br>    <SPAN style="color:#00007F">With</SPAN> Sheets("Sheet1")<br>        <SPAN style="color:#00007F">Set</SPAN> UR = .UsedRange<br>        Cols = UR.Columns.Count<br>        <SPAN style="color:#00007F">For</SPAN> c = 1 <SPAN style="color:#00007F">To</SPAN> Cols<br>            Intersect(.Columns(c), UR).Copy Destination:= _<br>                wsD.Range("A" & wsD.Rows.Count).End(xlUp).Offset(1)<br>        <SPAN style="color:#00007F">Next</SPAN> c<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    wsD.Columns("A").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>