View Single Post
  #9   Report Post  
Posted to microsoft.public.excel.worksheet.functions
CathyH CathyH is offline
external usenet poster
 
Posts: 25
Default Copy Multiple Columns, Paste Under a Single column

Ooops - that didn't format correctly when I posted but I think you get the
idea - I hope.

"CathyH" wrote:

This is great information for someone who knows absolutely nothing about
writing code. I'm hoping someone can help me take this a little further.

I have a spreadsheet with multiple sets (10 or more) , 4 columns each that I
want to paste (on a seperate sheet) into a single set of 4 columns.

An example:

Paint
Tools
Acct. Amt. Category Cost Center Acct. Amt. Category
Cost Center




These all have to be placedin one long column without blanks for uploading
into our accounting system.

Please help a code newbie!



"Gord Dibben" wrote:

And thanks to Bernie for the code.


Gord

On Fri, 4 May 2007 22:36:01 -0700, Sriram
wrote:

That Precisely Addressed my Problem Mr. Gord Dibben.

I THANK YOU from the bottom of my heart!!!

"Gord Dibben" wrote:

Can you handle a macro to add a worksheet and place all the columns into one
single column?

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

On Fri, 4 May 2007 01:55:01 -0700, Sriram
wrote:

I want to know whether we can copy multiple columns, and paste them into a
Single column, where all the copied values appear one below the other/
eliminating the Blanks...