On Monday, November 18, 2013 11:36:15 PM UTC-8, Claus Busch wrote:
Hi Howard,


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.

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