View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.newusers
Gord Dibben[_2_] Gord Dibben[_2_] is offline
external usenet poster
 
Posts: 621
Default Collating columns and rows to one columns

If you're not familiar with VBA and macros, see David McRitchie's site
for more on "getting started".

http://www.mvps.org/dmcritchie/excel/getstarted.htm

or Ron de De Bruin's site on where to store macros.

http://www.rondebruin.nl/code.htm

In the meantime..........

First...create a backup copy of your original workbook.

To create a General Module, hit ALT + F11 to open the Visual Basic
Editor.

Hit CRTL + r to open Project Explorer.

Find your workbook/project and select it.

Right-click and InsertModule. Paste the code in there. Save the
workbook and hit ALT + Q to return to your workbook.

Run or edit the macro by going to ToolMacroMacros.

You can also assign this macro to a button or a shortcut key combo.


Gord




On Tue, 26 Jun 2012 12:19:12 +0000, Dougie13
wrote:


'Gord Dibben[_2_ Wrote:
;1603147']A macro could be much faster when doing that many sheets.

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

On Mon, 25 Jun 2012 21:35:40 +0000, Dougie13
wrote:
-

Spencer101;1603115 Wrote: -
Hi,

4000 rows of data would probably be quicker to manipulate in this

way
manually than it would be to write some kind of formula/VBA.

How often do you need to do this?-

Hi, well I forgot to mention I have about 20 worksheets of the same

type
which all need collating into one column in each worksheet. To add, I
get this about twice a month so a formula would be of great help,

doing
in manually is undesirable really.

Thanks-


Thanks Gord for your work here, it's much appreciated but I'm afraid
I've no idea what to do with this? Do I have to type it out somewhere.
Apologies but I'm very inexperienced in excel.