SOme are 1 line, some are 2 line and some are 3 and some are 4, I would like to copy data in column H, into a seperate column L, M, N, O.....I cna then join them together....
Sub Data()
Dim r As Range, cel As Range, c As Range
Dim txt As String
Columns("J:J").Insert
Set r = Columns(1).SpecialCells(2, 1).Offset(, 7)
For Each cel In r
If cel.Offset(1) = "" Then
cel.Offset(, 2) = cel
Else
txt = ""
For Each c In Range(cel, cel.End(xlDown))
txt = txt & " " & c
Next
cel.Offset(, 2) = txt
End If
Next
Columns("J:J").EntireColumn.AutoFit
End Sub
[/vba]
or, with no extra column required
[VBA]Sub Data2()
Dim r As Range, cel As Range, c As Range
Dim txt As String
Set r = Columns(1).SpecialCells(2, 1).Offset(, 7)
For Each cel In r
If cel.Offset(1) = "" Then
'do nothing
Else
txt = ""
For Each c In Range(cel, cel.End(xlDown))
txt = txt & " " & c
c.Clear
Next
cel = txt
End If
Next
Columns("H:H").EntireColumn.AutoFit
End Sub
[/VBA]
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.
Sorry I have not writtten back sooner thanking you but I have been super busy...
One little tweek....
A few columns have been added and the data to work with is now in column J and not H
I read up on the Offset function and tried to modify your code but have not been able to figure it out, so could you please tell me how to modify the code to work with Col J???
[VBA]Sub Data2()
Dim r As Range, cel As Range, c As Range
Dim txt As String
Set r = Columns(1).SpecialCells(2, 1).Offset(, 9)
For Each cel In r
If cel.Offset(1) = "" Then
'do nothing
Else
txt = ""
For Each c In Range(cel, cel.End(xlDown))
txt = txt & " " & c
c.Clear
Next
cel = txt
End If
Next
Columns("J:J").EntireColumn.AutoFit
End Sub[/VBA]
MVP (Excel 2008-2010)
Post a workbook with sample data and layout if you want a quicker solution.