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

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

Thanks dave that worked out great, the only thing, I need to combine A1 to
A6 in one cell instead of multuple column , I will only one column

Thanks,

Albert
"Dave Peterson" wrote:

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

Usually people want the values separated by some kind of delimiter. I used
comma-space. Change it to what you want or use "" if you don't want anything.

Option Explicit
Sub testme()
Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim DestCell As Range
Dim BigArea As Range
Dim SmallArea As Range
Dim myCell As Range
Dim myStr As String
Dim myDelimiter As String

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

myDelimiter = ", "

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
myStr = ""
For Each myCell In SmallArea.Cells
myStr = myStr & myDelimiter & myCell.Value
Next myCell
If myStr < "" Then
myStr = Mid(myStr, Len(myDelimiter) + 1)
End If
DestCell.Value = myStr
Set DestCell = DestCell.Offset(1, 0)
Next SmallArea
End With

End Sub

Albert wrote:

Thanks dave that worked out great, the only thing, I need to combine A1 to
A6 in one cell instead of multuple column , I will only one column

Thanks,

Albert
"Dave Peterson" wrote:

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


--

Dave Peterson

Thanks Dave that's perfect

"Dave Peterson" wrote:

Usually people want the values separated by some kind of delimiter. I used
comma-space. Change it to what you want or use "" if you don't want anything.

Option Explicit
Sub testme()
Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim DestCell As Range
Dim BigArea As Range
Dim SmallArea As Range
Dim myCell As Range
Dim myStr As String
Dim myDelimiter As String

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

myDelimiter = ", "

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
myStr = ""
For Each myCell In SmallArea.Cells
myStr = myStr & myDelimiter & myCell.Value
Next myCell
If myStr < "" Then
myStr = Mid(myStr, Len(myDelimiter) + 1)
End If
DestCell.Value = myStr
Set DestCell = DestCell.Offset(1, 0)
Next SmallArea
End With

End Sub

Albert wrote:

Thanks dave that worked out great, the only thing, I need to combine A1 to
A6 in one cell instead of multuple column , I will only one column

Thanks,

Albert
"Dave Peterson" wrote:

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


--

Dave Peterson