Multiple cells in to one cell x times

[morgi666]

I have a list of keywords with names:
Something one
Something two
Something2 one
Something2 two
Something2 three

I need to put keywords to one cell but for every group i need new
cell.
I have something like this:

Sub CosTam()
IleSlow = Worksheets("to").Range("G1").Value
Pierwsza = 1
Druga = 0

Sheets("to").Select

For I = 1 To IleSlow
Roznica = Worksheets("to").Range("G" & I).Value
Druga = Druga + Roznica
Sheets("to").Range("C" & Pierwsza & ":C" & Druga).Select

For Each S In Selection
New_value = New_value & S.Value & ","
S.Value = ""
Next S
Worksheets("to").Range("H" & I).Value = New_value

Pierwsza = Pierwsza + Druga
Next I

End Sub

Its working, but only for first group. Then its not changing Nev_value
and pasting x times same thing.
If any one can halp me, that will be great.

Thanx

 

[Guest]

Sub CosTam()

LastRow = Cells(Rows.Count, 3).End(xlUp).Row
Set ColCRange = Range(Cells(1, 3), Cells(LastRow, 3))

RowCount = 1
New_value = ""
For Each cell In ColCRange

New_value = New_value & cell.Value & ","
If cell <> cell.Offset(rowoffset:=1, columnoffset:=0) Then

Worksheets("to").Range("H" & RowCount).Value = New_value
New_value = ""
RowCount = RowCount + 1
End If

Next cell

End Sub

 

[Morgoth]

Thx, but i need to select grops of keywords one by one and every group
put in one cell