I'm not a programmer, so I would appreciate any feedback
on this short macro I created. It takes multiple columns
of variable lengths and piles then in column A on a new
sheet. No error-trapping for more than 65,536 rows or an
empty column. Thanks. Jason

Sub OneColumn()

''''''''''''''''''''''''''''''''''''''''''
'Macro to copy columns of variable length'
'into 1 continous column in a new sheet '
''''''''''''''''''''''''''''''''''''''''''

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 idx As Integer

Set ws = ActiveWorkbook.activesheet
ilastcol = Cells(1, Columns.Count).End(xlToLeft).Column

With Sheets.Add
.Name = "Alldata"
End With

idx = Sheets("Alldata").Index
Sheets(idx + 1).Activate

For colndx = 1 To ilastcol

ilastrow = ws.Cells(Rows.Count, colndx).End(xlUp).Row
jlastrow = Sheets("Alldata").Cells(Rows.Count, 1) _
...End(xlUp).Row

Set myrng = Range(Cells(1, colndx), _
Cells(ilastrow, colndx))
With myrng
.Copy Sheets("Alldata").Cells(jlastrow + 1, 1)
End With
Next

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

End Sub

Hi Jason,

A couple of relatively minor points.

You use With to qualify an object, but for a single statement this has no
value, so

With Sheets.Add
.Name = "Alldata"
End With

should be

Sheets.Add.Name = "Alldata"

Also, you set worksheet objects most of the time, but also use implicit
referencing, which, with the multiple sheets referenced, makes it more
difficult to follow than it need be.


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Jason Morin" wrote in message
...
I'm not a programmer, so I would appreciate any feedback
on this short macro I created. It takes multiple columns
of variable lengths and piles then in column A on a new
sheet. No error-trapping for more than 65,536 rows or an
empty column. Thanks. Jason

Sub OneColumn()

''''''''''''''''''''''''''''''''''''''''''
'Macro to copy columns of variable length'
'into 1 continous column in a new sheet '
''''''''''''''''''''''''''''''''''''''''''

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 idx As Integer

Set ws = ActiveWorkbook.activesheet
ilastcol = Cells(1, Columns.Count).End(xlToLeft).Column

With Sheets.Add
.Name = "Alldata"
End With

idx = Sheets("Alldata").Index
Sheets(idx + 1).Activate

For colndx = 1 To ilastcol

ilastrow = ws.Cells(Rows.Count, colndx).End(xlUp).Row
jlastrow = Sheets("Alldata").Cells(Rows.Count, 1) _
..End(xlUp).Row

Set myrng = Range(Cells(1, colndx), _
Cells(ilastrow, colndx))
With myrng
.Copy Sheets("Alldata").Cells(jlastrow + 1, 1)
End With
Next

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

End Sub

Hi Bob-
Thanks for the feedback.
Jason

-----Original Message-----
Hi Jason,

A couple of relatively minor points.

You use With to qualify an object, but for a single
statement this has no
value, so

With Sheets.Add
.Name = "Alldata"
End With

should be

Sheets.Add.Name = "Alldata"

Also, you set worksheet objects most of the time, but
also use implicit
referencing, which, with the multiple sheets referenced,
makes it more
difficult to follow than it need be.


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Jason Morin" wrote in message
...
I'm not a programmer, so I would appreciate any feedback
on this short macro I created. It takes multiple columns
of variable lengths and piles then in column A on a new
sheet. No error-trapping for more than 65,536 rows or an
empty column. Thanks. Jason

Sub OneColumn()

''''''''''''''''''''''''''''''''''''''''''
'Macro to copy columns of variable length'
'into 1 continous column in a new sheet '
''''''''''''''''''''''''''''''''''''''''''

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 idx As Integer

Set ws = ActiveWorkbook.activesheet
ilastcol = Cells(1, Columns.Count).End(xlToLeft).Column

With Sheets.Add
.Name = "Alldata"
End With

idx = Sheets("Alldata").Index
Sheets(idx + 1).Activate

For colndx = 1 To ilastcol

ilastrow = ws.Cells(Rows.Count, colndx).End(xlUp).Row
jlastrow = Sheets("Alldata").Cells(Rows.Count, 1) _
..End(xlUp).Row

Set myrng = Range(Cells(1, colndx), _
Cells(ilastrow, colndx))
With myrng
.Copy Sheets("Alldata").Cells(jlastrow + 1, 1)
End With
Next

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

End Sub



.

It shouldn't work as written

One you add the sheet alldata, it is the active sheet. (and I don't see
anywhere that you change that)

but you set your range to copy with

Set myrng = Range(Cells(1, colndx), _
Cells(ilastrow, colndx))

the unqualified Range and Cells refers to the activesheet.

you should have

Set myrng = ws.Range(ws.Cells(1, colndx), _
ws.Cells(ilastrow, colndx))

--
Regards,
Tom Ogilvy


"Jason Morin" wrote in message
...
I'm not a programmer, so I would appreciate any feedback
on this short macro I created. It takes multiple columns
of variable lengths and piles then in column A on a new
sheet. No error-trapping for more than 65,536 rows or an
empty column. Thanks. Jason

Sub OneColumn()

''''''''''''''''''''''''''''''''''''''''''
'Macro to copy columns of variable length'
'into 1 continous column in a new sheet '
''''''''''''''''''''''''''''''''''''''''''

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 idx As Integer

Set ws = ActiveWorkbook.activesheet
ilastcol = Cells(1, Columns.Count).End(xlToLeft).Column

With Sheets.Add
.Name = "Alldata"
End With

idx = Sheets("Alldata").Index
Sheets(idx + 1).Activate

For colndx = 1 To ilastcol

ilastrow = ws.Cells(Rows.Count, colndx).End(xlUp).Row
jlastrow = Sheets("Alldata").Cells(Rows.Count, 1) _
..End(xlUp).Row

Set myrng = Range(Cells(1, colndx), _
Cells(ilastrow, colndx))
With myrng
.Copy Sheets("Alldata").Cells(jlastrow + 1, 1)
End With
Next

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

End Sub

Thanks for the feedback Tom. After I add "Alldata", I flip
back to the other sheet with

idx = Sheets("Alldata").Index
Sheets(idx + 1).Activate

which probably isn't the most efficient or prettiest way.

Jason

-----Original Message-----
It shouldn't work as written

One you add the sheet alldata, it is the active sheet.
(and I don't see
anywhere that you change that)

but you set your range to copy with

Set myrng = Range(Cells(1, colndx), _
Cells(ilastrow, colndx))

the unqualified Range and Cells refers to the activesheet.

you should have

Set myrng = ws.Range(ws.Cells(1, colndx), _
ws.Cells(ilastrow, colndx))

--
Regards,
Tom Ogilvy


"Jason Morin" wrote in message
...
I'm not a programmer, so I would appreciate any feedback
on this short macro I created. It takes multiple columns
of variable lengths and piles then in column A on a new
sheet. No error-trapping for more than 65,536 rows or an
empty column. Thanks. Jason

Sub OneColumn()

''''''''''''''''''''''''''''''''''''''''''
'Macro to copy columns of variable length'
'into 1 continous column in a new sheet '
''''''''''''''''''''''''''''''''''''''''''

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 idx As Integer

Set ws = ActiveWorkbook.activesheet
ilastcol = Cells(1, Columns.Count).End(xlToLeft).Column

With Sheets.Add
.Name = "Alldata"
End With

idx = Sheets("Alldata").Index
Sheets(idx + 1).Activate

For colndx = 1 To ilastcol

ilastrow = ws.Cells(Rows.Count, colndx).End(xlUp).Row
jlastrow = Sheets("Alldata").Cells(Rows.Count, 1) _
..End(xlUp).Row

Set myrng = Range(Cells(1, colndx), _
Cells(ilastrow, colndx))
With myrng
.Copy Sheets("Alldata").Cells(jlastrow + 1, 1)
End With
Next

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

End Sub



.

Hey Jason,

Congratulations, you are a programmer! You wrote a working macro and you've
identified some potential problems.

I've fiddled quite a bit with you're macro and tried to document. I tend to
err on the side of long variable names so I can remember what they mean, so
take that with a grain of salt. It looks like the empty column takes care
of itself because of your end(xlup) statement. I put in something for to
many rows and to delete any blank spaces that would result from blank rows
in your original data. Also, deleted "AllData" if it exists before starting
so you don't generate an error when you try to create it again. A few other
things too, hopefully the comments are clear.

Sub OneColumn()

''''''''''''''''''''''''''''''''''''''''''
'Macro to copy columns of variable length'
'into 1 continous column in a new sheet '
''''''''''''''''''''''''''''''''''''''''''

Dim from_lastcol As Long
Dim from_lastrow As Long
Dim to_lastrow As Long
Dim from_colndx As Long
Dim ws_from As Worksheet, ws_to As Worksheet

'turn off screen updating so runs faster/no flicker as move between
worksheets
Application.ScreenUpdating = False
'turn off calculation so runs faster if you have calculations in this sheet
Application.Calculation = xlCalculationManual

Set ws_from = ActiveWorkbook.ActiveSheet
from_lastcol = ws_from.Cells(1, Columns.Count).End(xlToLeft).Column

'Turn error checking off so if no "AllData" trying to delete doesn't
generate error
On Error Resume Next
'so not prompted to confirm delete
Application.DisplayAlerts = False
'Delete if already exists so don't get error
ActiveWorkbook.Worksheets("AllData").Delete
Application.DisplayAlerts = True
'turn error checking back on
On Error GoTo 0

'since you refer to "AllData" throughout
Set ws_to = Worksheets.Add
ws_to.Name = "AllData"

For from_colndx = 1 To from_lastcol
from_lastrow = ws_from.Cells(Rows.Count, from_colndx).End(xlUp).Row
'If you're going to exceed 65536 rows
If from_lastrow + ws_to.Cells(Rows.Count, 1).End(xlUp).Row <= 65536 Then
to_lastrow = ws_to.Cells(Rows.Count, 1).End(xlUp).Row
Else
MsgBox "This time you've gone to far"
Exit Sub
End If
ws_from.Range(ws_from.Cells(1, from_colndx), ws_from.Cells(from_lastrow,
from_colndx)).Copy ws_to.Cells(to_lastrow + 1, 1)
Next

' this deletes any blank rows
ws_to.Columns(1).SpecialCells(xlCellTypeBlanks).En tireRow.Delete

'turn screen updating back on
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic 'ditto calculation

End Sub

hth,

Doug

"Jason Morin" wrote in message
...
I'm not a programmer, so I would appreciate any feedback
on this short macro I created. It takes multiple columns
of variable lengths and piles then in column A on a new
sheet. No error-trapping for more than 65,536 rows or an
empty column. Thanks. Jason

Sub OneColumn()

''''''''''''''''''''''''''''''''''''''''''
'Macro to copy columns of variable length'
'into 1 continous column in a new sheet '
''''''''''''''''''''''''''''''''''''''''''

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 idx As Integer

Set ws = ActiveWorkbook.activesheet
ilastcol = Cells(1, Columns.Count).End(xlToLeft).Column

With Sheets.Add
.Name = "Alldata"
End With

idx = Sheets("Alldata").Index
Sheets(idx + 1).Activate

For colndx = 1 To ilastcol

ilastrow = ws.Cells(Rows.Count, colndx).End(xlUp).Row
jlastrow = Sheets("Alldata").Cells(Rows.Count, 1) _
..End(xlUp).Row

Set myrng = Range(Cells(1, colndx), _
Cells(ilastrow, colndx))
With myrng
.Copy Sheets("Alldata").Cells(jlastrow + 1, 1)
End With
Next

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

End Sub

Great feedback, Doug. Thanks. But I'm not a
programmer...I'm an engineer. ;)

-----Original Message-----
Hey Jason,

Congratulations, you are a programmer! You wrote a
working macro and you've
identified some potential problems.

I've fiddled quite a bit with you're macro and tried to
document. I tend to
err on the side of long variable names so I can remember
what they mean, so
take that with a grain of salt. It looks like the empty
column takes care
of itself because of your end(xlup) statement. I put in
something for to
many rows and to delete any blank spaces that would
result from blank rows
in your original data. Also, deleted "AllData" if it
exists before starting
so you don't generate an error when you try to create it
again. A few other
things too, hopefully the comments are clear.

Sub OneColumn()

''''''''''''''''''''''''''''''''''''''''''
'Macro to copy columns of variable length'
'into 1 continous column in a new sheet '
''''''''''''''''''''''''''''''''''''''''''

Dim from_lastcol As Long
Dim from_lastrow As Long
Dim to_lastrow As Long
Dim from_colndx As Long
Dim ws_from As Worksheet, ws_to As Worksheet

'turn off screen updating so runs faster/no flicker as
move between
worksheets
Application.ScreenUpdating = False
'turn off calculation so runs faster if you have
calculations in this sheet
Application.Calculation = xlCalculationManual

Set ws_from = ActiveWorkbook.ActiveSheet
from_lastcol = ws_from.Cells(1, Columns.Count).End
(xlToLeft).Column

'Turn error checking off so if no "AllData" trying to
delete doesn't
generate error
On Error Resume Next
'so not prompted to confirm delete
Application.DisplayAlerts = False
'Delete if already exists so don't get error
ActiveWorkbook.Worksheets("AllData").Delete
Application.DisplayAlerts = True
'turn error checking back on
On Error GoTo 0

'since you refer to "AllData" throughout
Set ws_to = Worksheets.Add
ws_to.Name = "AllData"

For from_colndx = 1 To from_lastcol
from_lastrow = ws_from.Cells(Rows.Count,
from_colndx).End(xlUp).Row
'If you're going to exceed 65536 rows
If from_lastrow + ws_to.Cells(Rows.Count, 1).End
(xlUp).Row <= 65536 Then
to_lastrow = ws_to.Cells(Rows.Count, 1).End
(xlUp).Row
Else
MsgBox "This time you've gone to far"
Exit Sub
End If
ws_from.Range(ws_from.Cells(1, from_colndx),
ws_from.Cells(from_lastrow,
from_colndx)).Copy ws_to.Cells(to_lastrow + 1, 1)
Next

' this deletes any blank rows
ws_to.Columns(1).SpecialCells
(xlCellTypeBlanks).EntireRow.Delete

'turn screen updating back on
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic 'ditto
calculation

End Sub

hth,

Doug

"Jason Morin" wrote in message
...
I'm not a programmer, so I would appreciate any feedback
on this short macro I created. It takes multiple columns
of variable lengths and piles then in column A on a new
sheet. No error-trapping for more than 65,536 rows or an
empty column. Thanks. Jason

Sub OneColumn()

''''''''''''''''''''''''''''''''''''''''''
'Macro to copy columns of variable length'
'into 1 continous column in a new sheet '
''''''''''''''''''''''''''''''''''''''''''

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 idx As Integer

Set ws = ActiveWorkbook.activesheet
ilastcol = Cells(1, Columns.Count).End(xlToLeft).Column

With Sheets.Add
.Name = "Alldata"
End With

idx = Sheets("Alldata").Index
Sheets(idx + 1).Activate

For colndx = 1 To ilastcol

ilastrow = ws.Cells(Rows.Count, colndx).End(xlUp).Row
jlastrow = Sheets("Alldata").Cells(Rows.Count, 1) _
..End(xlUp).Row

Set myrng = Range(Cells(1, colndx), _
Cells(ilastrow, colndx))
With myrng
.Copy Sheets("Alldata").Cells(jlastrow + 1, 1)
End With
Next

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

End Sub



.

Jason -

You're an engineer, so you'll be a better programmer than a "regular"
programmer. Your programs will do useful stuff, in ways that make sense
to its users.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Peltier Technical Services
http://PeltierTech.com/Excel/Charts/
_______

Jason Morin wrote:

Great feedback, Doug. Thanks. But I'm not a
programmer...I'm an engineer. ;)


-----Original Message-----
Hey Jason,

Congratulations, you are a programmer! You wrote a

working macro and you've

identified some potential problems.

I've fiddled quite a bit with you're macro and tried to

document. I tend to

err on the side of long variable names so I can remember

what they mean, so

take that with a grain of salt. It looks like the empty

column takes care

of itself because of your end(xlup) statement. I put in

something for to

many rows and to delete any blank spaces that would

result from blank rows

in your original data. Also, deleted "AllData" if it

exists before starting

so you don't generate an error when you try to create it

again. A few other

things too, hopefully the comments are clear.

Sub OneColumn()

''''''''''''''''''''''''''''''''''''''''''
'Macro to copy columns of variable length'
'into 1 continous column in a new sheet '
''''''''''''''''''''''''''''''''''''''''''

Dim from_lastcol As Long
Dim from_lastrow As Long
Dim to_lastrow As Long
Dim from_colndx As Long
Dim ws_from As Worksheet, ws_to As Worksheet

'turn off screen updating so runs faster/no flicker as

move between

worksheets
Application.ScreenUpdating = False
'turn off calculation so runs faster if you have

calculations in this sheet

Application.Calculation = xlCalculationManual

Set ws_from = ActiveWorkbook.ActiveSheet
from_lastcol = ws_from.Cells(1, Columns.Count).End

(xlToLeft).Column

'Turn error checking off so if no "AllData" trying to

delete doesn't

generate error
On Error Resume Next
'so not prompted to confirm delete
Application.DisplayAlerts = False
'Delete if already exists so don't get error
ActiveWorkbook.Worksheets("AllData").Delete
Application.DisplayAlerts = True
'turn error checking back on
On Error GoTo 0

'since you refer to "AllData" throughout
Set ws_to = Worksheets.Add
ws_to.Name = "AllData"

For from_colndx = 1 To from_lastcol
from_lastrow = ws_from.Cells(Rows.Count,

from_colndx).End(xlUp).Row

'If you're going to exceed 65536 rows
If from_lastrow + ws_to.Cells(Rows.Count, 1).End

(xlUp).Row <= 65536 Then

to_lastrow = ws_to.Cells(Rows.Count, 1).End

(xlUp).Row

Else
MsgBox "This time you've gone to far"
Exit Sub
End If
ws_from.Range(ws_from.Cells(1, from_colndx),

ws_from.Cells(from_lastrow,

from_colndx)).Copy ws_to.Cells(to_lastrow + 1, 1)
Next

' this deletes any blank rows
ws_to.Columns(1).SpecialCells

(xlCellTypeBlanks).EntireRow.Delete

'turn screen updating back on
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic 'ditto

calculation

End Sub

hth,

Doug

"Jason Morin" wrote in message
.. .

I'm not a programmer, so I would appreciate any feedback
on this short macro I created. It takes multiple columns
of variable lengths and piles then in column A on a new
sheet. No error-trapping for more than 65,536 rows or an
empty column. Thanks. Jason

Sub OneColumn()

''''''''''''''''''''''''''''''''''''''''''
'Macro to copy columns of variable length'
'into 1 continous column in a new sheet '
''''''''''''''''''''''''''''''''''''''''''

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 idx As Integer

Set ws = ActiveWorkbook.activesheet
ilastcol = Cells(1, Columns.Count).End(xlToLeft).Column

With Sheets.Add
.Name = "Alldata"
End With

idx = Sheets("Alldata").Index
Sheets(idx + 1).Activate

For colndx = 1 To ilastcol

ilastrow = ws.Cells(Rows.Count, colndx).End(xlUp).Row
jlastrow = Sheets("Alldata").Cells(Rows.Count, 1) _
..End(xlUp).Row

Set myrng = Range(Cells(1, colndx), _
Cells(ilastrow, colndx))
With myrng
.Copy Sheets("Alldata").Cells(jlastrow + 1, 1)
End With
Next

Sheets("Alldata").Rows("1:1").EntireRow.Delet e

End Sub



.

Seeing as most programmers work from specs that are written by designers,
and are tested by a testing team, if the programs don't do useful stuff, or
it doesn't make sense to its users, that is not necessarily bad programming,
it is more likely to be down to bad design and/or bad testing.

Bob

"Jon Peltier" wrote in message
...
Jason -

You're an engineer, so you'll be a better programmer than a "regular"
programmer. Your programs will do useful stuff, in ways that make sense
to its users.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Peltier Technical Services
http://PeltierTech.com/Excel/Charts/
_______

Jason Morin wrote:

Great feedback, Doug. Thanks. But I'm not a
programmer...I'm an engineer. ;)

You're welcome!

Doug

"Jason Morin" wrote in message
...
Great feedback, Doug. Thanks. But I'm not a
programmer...I'm an engineer. ;)

-----Original Message-----
Hey Jason,

Congratulations, you are a programmer! You wrote a
working macro and you've
identified some potential problems.

I've fiddled quite a bit with you're macro and tried to
document. I tend to
err on the side of long variable names so I can remember
what they mean, so
take that with a grain of salt. It looks like the empty
column takes care
of itself because of your end(xlup) statement. I put in
something for to
many rows and to delete any blank spaces that would
result from blank rows
in your original data. Also, deleted "AllData" if it
exists before starting
so you don't generate an error when you try to create it
again. A few other
things too, hopefully the comments are clear.

Sub OneColumn()

''''''''''''''''''''''''''''''''''''''''''
'Macro to copy columns of variable length'
'into 1 continous column in a new sheet '
''''''''''''''''''''''''''''''''''''''''''

Dim from_lastcol As Long
Dim from_lastrow As Long
Dim to_lastrow As Long
Dim from_colndx As Long
Dim ws_from As Worksheet, ws_to As Worksheet

'turn off screen updating so runs faster/no flicker as
move between
worksheets
Application.ScreenUpdating = False
'turn off calculation so runs faster if you have
calculations in this sheet
Application.Calculation = xlCalculationManual

Set ws_from = ActiveWorkbook.ActiveSheet
from_lastcol = ws_from.Cells(1, Columns.Count).End
(xlToLeft).Column

'Turn error checking off so if no "AllData" trying to
delete doesn't
generate error
On Error Resume Next
'so not prompted to confirm delete
Application.DisplayAlerts = False
'Delete if already exists so don't get error
ActiveWorkbook.Worksheets("AllData").Delete
Application.DisplayAlerts = True
'turn error checking back on
On Error GoTo 0

'since you refer to "AllData" throughout
Set ws_to = Worksheets.Add
ws_to.Name = "AllData"

For from_colndx = 1 To from_lastcol
from_lastrow = ws_from.Cells(Rows.Count,
from_colndx).End(xlUp).Row
'If you're going to exceed 65536 rows
If from_lastrow + ws_to.Cells(Rows.Count, 1).End
(xlUp).Row <= 65536 Then
to_lastrow = ws_to.Cells(Rows.Count, 1).End
(xlUp).Row
Else
MsgBox "This time you've gone to far"
Exit Sub
End If
ws_from.Range(ws_from.Cells(1, from_colndx),
ws_from.Cells(from_lastrow,
from_colndx)).Copy ws_to.Cells(to_lastrow + 1, 1)
Next

' this deletes any blank rows
ws_to.Columns(1).SpecialCells
(xlCellTypeBlanks).EntireRow.Delete

'turn screen updating back on
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic 'ditto
calculation

End Sub

hth,

Doug

"Jason Morin" wrote in message
...
I'm not a programmer, so I would appreciate any feedback
on this short macro I created. It takes multiple columns
of variable lengths and piles then in column A on a new
sheet. No error-trapping for more than 65,536 rows or an
empty column. Thanks. Jason

Sub OneColumn()

''''''''''''''''''''''''''''''''''''''''''
'Macro to copy columns of variable length'
'into 1 continous column in a new sheet '
''''''''''''''''''''''''''''''''''''''''''

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 idx As Integer

Set ws = ActiveWorkbook.activesheet
ilastcol = Cells(1, Columns.Count).End(xlToLeft).Column

With Sheets.Add
.Name = "Alldata"
End With

idx = Sheets("Alldata").Index
Sheets(idx + 1).Activate

For colndx = 1 To ilastcol

ilastrow = ws.Cells(Rows.Count, colndx).End(xlUp).Row
jlastrow = Sheets("Alldata").Cells(Rows.Count, 1) _
..End(xlUp).Row

Set myrng = Range(Cells(1, colndx), _
Cells(ilastrow, colndx))
With myrng
.Copy Sheets("Alldata").Cells(jlastrow + 1, 1)
End With
Next

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

End Sub



.

You've got one more reply at your other post.

Jason Morin wrote:

I'm not a programmer, so I would appreciate any feedback
on this short macro I created. It takes multiple columns
of variable lengths and piles then in column A on a new
sheet. No error-trapping for more than 65,536 rows or an
empty column. Thanks. Jason

Sub OneColumn()

''''''''''''''''''''''''''''''''''''''''''
'Macro to copy columns of variable length'
'into 1 continous column in a new sheet '
''''''''''''''''''''''''''''''''''''''''''

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 idx As Integer

Set ws = ActiveWorkbook.activesheet
ilastcol = Cells(1, Columns.Count).End(xlToLeft).Column

With Sheets.Add
.Name = "Alldata"
End With

idx = Sheets("Alldata").Index
Sheets(idx + 1).Activate

For colndx = 1 To ilastcol

ilastrow = ws.Cells(Rows.Count, colndx).End(xlUp).Row
jlastrow = Sheets("Alldata").Cells(Rows.Count, 1) _
..End(xlUp).Row

Set myrng = Range(Cells(1, colndx), _
Cells(ilastrow, colndx))
With myrng
.Copy Sheets("Alldata").Cells(jlastrow + 1, 1)
End With
Next

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

End Sub

--

Dave Peterson