Maybe...

Option Explicit
Sub testme()
Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim DestCell As Range
Dim BigArea As Range
Dim SmallArea As Range

Set CurWks = Worksheets("Sheet1")
Set NewWks = Worksheets.Add
Set DestCell = NewWks.Range("A1")

With CurWks
Set BigArea = Nothing
On Error Resume Next
Set BigArea = .Columns(1).Cells.SpecialCells(xlCellTypeConstants )
On Error GoTo 0

If BigArea Is Nothing Then
MsgBox "No constants in column A"
Exit Sub
End If

For Each SmallArea In BigArea.Areas
SmallArea.Copy
DestCell.PasteSpecial Transpose:=True
Set DestCell = DestCell.Offset(1, 0)
Next SmallArea
End With

End Sub

This will not do what you want if you have any formulas in column A.



Albert wrote:

I have similar issue but more complecated.

Here is an example of wha I am tying to do:

A1 = 123b
A2 = asf
A3 = afasf
A4 = afasf
A5 = awry
A6 = net
A7 =
A8 = tegndg
A9 = dgndg
A10 = dgndg
A11 = sd
A12 = sdb
A13 = fbsf
A14 = sffsbsf
A15 =
A16 = sfbsf
A17 = sfbsf
A18 = bwr
A19 = sfbsf
A20 = sfbsf
A21 =
A22 = sfbsf
A23 = sfbsfb
A24 = sfbf
A25 = sfb
A26 = sfb
A27 = sf
A28 =

I need all text in one row for text located between an empty cells, so A1 to
A6 will combined, A8 to A14 will combined, A16 to A20 will combined,
preferably in anew sheet.

Thanks,

Albert

--

Dave Peterson