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.


Works a treat. Thank you.

Regards,
Howard