copy & paste (To: choice)
 

Try this -- it assumes that all your copy-from data is in a range name
"SourceRange" and that a single cell with enough room below it for al
the output is named "TargetRange"

Sub Transpozem()
Dim srng As Range, trng As Range, ctr As Integer
Set srng = ActiveSheet.Range("SourceRange")
Set trng = ActiveSheet.Range("TargetRange")
ctr = 1
For Each Cell In srng
If Cell.Value < "" Then
trng.Offset(ctr, 0) = Cell.Value
ctr = ctr + 1
End If
Next Cell
End Sub

Regards,
billy

--
Message posted from http://www.ExcelForum.com