Hari

There is little need to activate or select. Each time you do Excel
has to re-draw the screen which takes considerable time.

If you are likely to switch back and forth between workbooks you can
assign them to object variables and use these to refer to them quickly
and accurately without selection or activation.

I suspect the code below, which while definately not the best will run
about 100 times quicker than loads of activating and selecting

Sub CopyNonBlankData()
Dim NewWb As Workbook, NewWks As Worksheet
Dim CurrWks As Worksheet, rng As Range
Dim lLastFixedRow As Long, iLastCol As Integer
Dim lLastVariableRow As Long

Set CurrWks = ThisWorkbook.Worksheets("basesheet")
Set NewWb = Workbooks.Add
Set NewWks = NewWb.Worksheets(1)
lLastFixedRow = CurrWks.Range("O65536").End(xlUp).Row

For Each rng In CurrWks.Range("O2:O" & lLastFixedRow)
iLastCol = rng.Offset(0, 6).End(xlToLeft).Column
lLastVariableRow = NewWks.Range("A65536").End(xlUp).Row + 1
rng.Resize(, iLastCol - 14).Copy
NewWks.Range("A" & lLastVariableRow).PasteSpecial _
Paste:=xlPasteValues, Transpose:=True
Next rng
End Sub


Nick Hodge
Microsoft MVP - Excel
Southampton, England

On Sun, 30 Jan 2005 19:57:19 +0530, "Hari Prasadh"
wrote:

Hi,

I have data in column O (starting from row number 2) and it could extend up
to let's say till column T within a worksheet called "basesheet". the number
of rows will be variable.

There is a pattern for data being filled up in these columns. Column O is
never empty. But, ...if column P is empty then all columns after that will
be empty for that row. Similarly if column Q is empty then all columns after
that will be empty and so on...

I want to copy all the Non-empty cells from column O to column T in to
another New Workbook, starting from Cell A1 within a SINGLE COLUMN. (using
Transpose)

Whats the most efficient way (time- wise). I have pasted my attempt below.

Please tell the places where I can make the code faster. ( Basically, I have
to do this for around 70 worksheets and many rows, thats why Iam asking for
a more efficient code).



Option Explicit

Sub try()

Dim NewWorkBookName As String
Dim i As Long

Workbooks.Add
NewWorkBookName = ActiveWorkbook.Name

ThisWorkbook.Worksheets("basesheet").Activate

For i = 2 To Range("o65536").End(xlUp).Row

Cells(i, Range("iv" & i).End(xlToLeft).Column).Select
Debug.Assert (ActiveCell.Row < 9)
If ActiveCell.Column = 15 Then
ActiveCell.Copy
Else
Range(ActiveCell, Cells(i, "o")).Copy
End If

Workbooks(NewWorkBookName).sheets("sheet1").Activa te
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks
_
:=False, Transpose:=True
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select

ThisWorkbook.Worksheets("basesheet").Activate
Next i

End Sub


Thanks a lot,
Hari
India