VBA - specify where data is placed on new sheet

[CathyH]

I am attempting to modify a VBA posted on this site.

This works great for making one continuos column from a lot of other columns
but what I'm trying to do is paste Columns N,S & X underneath each other in
Column A of the new sheet, then paste Columns O,T & Y underneath each other
in Column B of the new sheet, etc. etc.

The columns will be of various lengths each month.

Any help would be most appreciated.

Cathy


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

 

[Jim Cone]

Cathy,

The logic...
find the bottom of Column N
find the bottom of Column A (new sheet)
paste column N at bottom of Column A (new sheet)

find the bottom of Column S
find the bottom of Column A (new sheet)
paste Column S at bottom of Column A (new sheet)

same for Column X

To find the first empty cell at the bottom of a column use...
With Worksheets("OldSheet")
Set rngCell = .Cells(.Rows.Count, "N").End (xlUp)(2, 1)
End With
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware




"CathyH" <[email protected]>
wrote in message
I am attempting to modify a VBA posted on this site.

This works great for making one continuos column from a lot of other columns
but what I'm trying to do is paste Columns N,S & X underneath each other in
Column A of the new sheet, then paste Columns O,T & Y underneath each other
in Column B of the new sheet, etc. etc.

The columns will be of various lengths each month.

Any help would be most appreciated.

Cathy


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

 

[CathyH]

I'm having no luck with this but I'm a VBA newbie/dunce plus my mouse stopped
working so I'm quitting.

 

[Jim Cone]

Sub MakeLongColumns()
Dim lngCounter As Long
Dim lngBottom As Long
Dim lngTemp As Long
Dim lngCol As Long
Dim N As Long
lngCounter = 0
lngTemp = 1
lngCol = 1

For N = 14 To 64 Step 5
With Worksheets("OldSheet")
lngBottom = .Cells(.Rows.Count, N).End(xlUp).Row
.Range(.Cells(1, N), .Cells(lngBottom, N)).Copy _
Destination:=Worksheets("NewSheet").Cells(lngTemp, lngCol)
End With
lngCounter = lngCounter + 1
lngTemp = lngTemp + lngBottom
If lngCounter Mod 3 = 0 Then
lngCol = lngCol + 1
lngTemp = 1
End If
Next
End Sub
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
(Excel add-ins... sort colors, compare, arrange columns, thesaurus)



"CathyH" <[email protected]>
wrote in message
I'm having no luck with this but I'm a VBA newbie/dunce plus my mouse stopped
working so I'm quitting.

 

[CathyH]

How do I then say: for Column O, start at Row 1, Column "B" (new sheet)?

 

[Jim Cone]

Sub MakeLongColumns_R1()
'Jim Cone - San Francisco - USA - 06/06/2007
Dim lngCounter As Long
Dim lngBottom As Long
Dim lngTemp As Long
Dim lngCol As Long
Dim M As Long
Dim N As Long
lngCounter = 0
lngTemp = 1
lngCol = 1

For M = 1 To 15
For N = (M + 13) To (M + 23) Step 5
With Worksheets("OldSheet")
lngBottom = .Cells(.Rows.Count, N).End(xlUp).Row
.Range(.Cells(1, N), .Cells(lngBottom, N)).Copy _
Destination:=Worksheets("NewSheet").Cells(lngTemp, lngCol)
End With
lngCounter = lngCounter + 1
lngTemp = lngTemp + lngBottom
If lngCounter Mod 3 = 0 Then
lngCol = lngCol + 1
lngTemp = 1
End If
Next
Next
End Sub
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware



"CathyH" <[email protected]>
wrote in message
How do I then say: for Column O, start at Row 1, Column "B" (new sheet)?