Code copies twice...?

H

Howard

In workbook, I have six sheets. Sheets 1, 2 & 3 have data in column A with varied number of rows.

The code here copies each of those columns to sheet 4, Column A. BUT does it twice. Sheet data 1, 2, 3 listed in sheet 4 followed by an identical list right below the first.

Once I get the double copy solved, I intend to use an array with the elements as the sheets I want to copy from. There is a sheet 5 & 6 but they are blank now. Still I would prefer to avoid even looking at them unless they were included in the array.

Thanks,
Howard

Option Explicit

Sub ThreeColumnsToOne()

Dim lastRow As Long, lastRowDest As Long
Dim ws As Worksheet

Application.ScreenUpdating = False

lastRowDest = 1

For Each ws In ThisWorkbook.Sheets
lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
ws.Range("A1:A" & lastRow).Copy Destination:=Sheets("Sheet4").Range("A" & lastRowDest)(1)
lastRowDest = Sheets("Sheet4").Range("A" & Rows.Count).End(xlUp).Row + 1
Next

Application.ScreenUpdating = True
MsgBox "Done!"

End Sub
 
C

Claus Busch

Hi Howard,

Am Mon, 18 Nov 2013 22:33:03 -0800 (PST) schrieb Howard:
In workbook, I have six sheets. Sheets 1, 2 & 3 have data in column A with varied number of rows.

The code here copies each of those columns to sheet 4, Column A. BUT does it twice. Sheet data 1, 2, 3 listed in sheet 4 followed by an identical list right below the first.

Once I get the double copy solved, I intend to use an array with the elements as the sheets I want to copy from. There is a sheet 5 & 6 but they are blank now. Still I would prefer to avoid even looking at them unless they were included in the array.
Click to expand...

try:

Sub ThreeColumnsToOne()

Dim lastRow As Long, lastRowDest As Long
Dim varOut As Variant
Dim i As Integer

Application.ScreenUpdating = False

lastRowDest = 1

For i = 1 To 3
With Sheets(i)
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
varOut = .Range("A1:A" & lastRow)
Sheets(4).Cells(Rows.Count, lastRowDest).End(xlUp) _
.Offset(1, 0).Resize(rowsize:=lastRow) = varOut
End With
Next

Application.ScreenUpdating = True
MsgBox "Done!"

End Sub


Regards
Claus B.
 
H

Howard

Hi Howard,

Sub ThreeColumnsToOne()

Dim lastRow As Long, lastRowDest As Long

Dim varOut As Variant

Dim i As Integer



Application.ScreenUpdating = False



lastRowDest = 1



For i = 1 To 3

With Sheets(i)

lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

varOut = .Range("A1:A" & lastRow)

Sheets(4).Cells(Rows.Count, lastRowDest).End(xlUp) _

.Offset(1, 0).Resize(rowsize:=lastRow) = varOut

End With

Next



Application.ScreenUpdating = True

MsgBox "Done!"



End Sub





Regards

Claus B.
Click to expand...

I'll give your suggestion a go, I'm sure it will work.

I have tried this worksheet array and the new problem with it is that I only get the Sheet 3 data copied into Sheet 4.

I'm thinking the advantage here is that the sheet selection and the sheet order can be adjusted in the array.

Say Worksheets(Array("Sheet3", "Sheet6", "Sheet1")) (Omitting sheets 1, 2 from the copy to sheet 4)

Does that make any sense?

Howard


Sub ThreeColumnsToOne()

Dim lastRow As Long, lastRowDest As Long
Dim sh As Worksheet
Application.ScreenUpdating = False

For Each sh In Worksheets(Array("Sheet1", "Sheet2", "Sheet3"))
lastRowDest = 1
lastRow = sh.Range("A" & Rows.Count).End(xlUp).Row
sh.Range("A1:A" & lastRow).Copy Destination:=Sheets("Sheet4").Range("A" & lastRowDest)
lastRowDest = Sheets("Sheet4").Range("A" & Rows.Count).End(xlUp).Row + 1
Next

Application.ScreenUpdating = True
MsgBox "Done!"

End Sub
 
C

Claus Busch

Hi Howard,

Am Mon, 18 Nov 2013 23:55:59 -0800 (PST) schrieb Howard:
I have tried this worksheet array and the new problem with it is that I only get the Sheet 3 data copied into Sheet 4.

I'm thinking the advantage here is that the sheet selection and the sheet order can be adjusted in the array.

Say Worksheets(Array("Sheet3", "Sheet6", "Sheet1")) (Omitting sheets 1, 2 from the copy to sheet 4)
Click to expand...

with a sheet array try:

Sub ThreeColumnsToOne()

Dim lastRow As Long, lastRowDest As Long
Dim varSheets As Variant
Dim varOut As Variant
Dim i As Integer
Application.ScreenUpdating = False

varSheets = Array("Sheet1", "Sheet2", "Sheet3")
lastRowDest = 1
For i = LBound(varSheets) To UBound(varSheets)
With Sheets(varSheets(i))
lastRow = .Range("A" & Rows.Count).End(xlUp).Row
varOut = .Range("A1:A" & lastRow)
Sheets("Sheet4").Cells(lastRowDest, 1) _
.Resize(rowsize:=lastRow) = varOut
lastRowDest = Sheets("Sheet4").Range("A" & Rows.Count) _
.End(xlUp).Row + 1
End With
Next

Application.ScreenUpdating = True
MsgBox "Done!"

End Sub


Regards
Claus B.
 
H

Howard

with a sheet array try:
Sub ThreeColumnsToOne()



Dim lastRow As Long, lastRowDest As Long

Dim varSheets As Variant

Dim varOut As Variant

Dim i As Integer

Application.ScreenUpdating = False



varSheets = Array("Sheet1", "Sheet2", "Sheet3")

lastRowDest = 1

For i = LBound(varSheets) To UBound(varSheets)

With Sheets(varSheets(i))

lastRow = .Range("A" & Rows.Count).End(xlUp).Row

varOut = .Range("A1:A" & lastRow)

Sheets("Sheet4").Cells(lastRowDest, 1) _

.Resize(rowsize:=lastRow) = varOut

lastRowDest = Sheets("Sheet4").Range("A" & Rows.Count) _

.End(xlUp).Row + 1

End With

Next



Application.ScreenUpdating = True

MsgBox "Done!"



End Sub
Click to expand...
Regards

Claus B.
Click to expand...


Works a treat. Thank you.

Regards,
Howard
 
G

GS

If you pre-select (group) the sheets to copy from then you can iterate
as follows...

For Each ws In ActiveWindow.SelectedSheets
'code here
Next 'ws

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
H

Howard

If you pre-select (group) the sheets to copy from then you can iterate

as follows...



For Each ws In ActiveWindow.SelectedSheets

'code here

Next 'ws
Click to expand...

Hi Garry,

It's not clear to me how you mean "If you pre-select (group)the sheets..."

Something like this, maybe, but really I'm just guessing.

Set SelectedSheets = (Sheet1,Sheet2,Sheet3)

Howard
 
G

GS

Hi Garry,

It's not clear to me how you mean "If you pre-select (group)the
sheets..."

Something like this, maybe, but really I'm just guessing.

Set SelectedSheets = (Sheet1,Sheet2,Sheet3)

Howard
Click to expand...

No! I mean the user selects the sheets to copy data from, then runs the
code. This serves not knowing in advance which sheets the data needs to
be copied from.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
H

Howard

No! I mean the user selects the sheets to copy data from, then runs the

code. This serves not knowing in advance which sheets the data needs to

be copied from.
Click to expand...

Okay, that makes sense, so would Alt + click each sheet tab you wanted to copy from?

Howard
 
H

Howard

Oops! Should read...



*Shift* works for contiguous sheets. Use Ctrl otherwise!
Click to expand...


It's more difficult to spell it out in type than to just do it. If I get it wrong on the first try, easy enough to back out and use the other key. lol

Howard
 
G

GS

It's more difficult to spell it out in type than to just do it. If I
get it wrong on the first try, easy enough to back out and use the
other key. lol

Howard
Click to expand...

Well.., you can use them in combination too when some sheets are
contiguous and some are not!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA Coding Help for Beginner 0
revise CONCATENATE code 2
CONCATENATE code 2
How to incorporate 2 sets of changing named ranges 2
Test named range exists & exclude worksheet if it doesn't 5
Code copies ONLY last j from sheet 9
Search other sheets for numbers & color them 10
Select Case Code does not run... 10

Top