I think you need to move down the column  concatonating the cell contents.
There are a number of ways of doing this.

For example... Assuming the data starts in A1 and there are no empty cells
till the end....

Sub subCollateData()

Dim slSummary() As String
Dim slSplit() As String
Dim slName As String
Dim ilUBound As Integer
Dim slValue As String

' Go to the sheet and select top cell.
Sheets("sheet1").Activate
Range("a1").Select

' Set up variables.
slName = ""
slValue = ""
ReDim slSummary(0)
slSummary(0) = "Region Summary"

' Loop till first empty cell.
Do

' Split up data into an array.
slSplit = Split(ActiveCell.Value)

' Are we at the end?
If Len(ActiveCell.Value) = 0 Then

' Get last data item.
slValue = Mid(slValue, 1, Len(slValue) - 1)
ilUBound = UBound(slSummary) + 1
ReDim Preserve slSummary(ilUBound)
slSummary(ilUBound) = slName & " " & slValue
slValue = ""
Exit Do
End If
If slSplit(0) <> slName Then
If ActiveCell.Row > 1 Then
slValue = Mid(slValue, 1, Len(slValue) - 1)
ilUBound = UBound(slSummary) + 1
ReDim Preserve slSummary(ilUBound)
slSummary(ilUBound) = slName & " " & slValue
slValue = ""
End If
slName = slSplit(0)
End If
slValue = slValue & slSplit(1) & ","
ActiveCell.Offset(1, 0).Select
Loop

Sheets("sheet2").Activate
Range("a1").Select
For ilUBound = 0 To UBound(slSummary)
ActiveCell.Value = slSummary(ilUBound)
ActiveCell.Offset(1, 0).Select
Next ilUBound
Range("a1").Select

End Sub

The above ... though Q&D .... should do what you want.

the code  is working...but haven't got the right output..
the prob is i need to create a new column  out of the given data but still keep
the old data.
something like this:

Region(DATA) Region Summary(output)
Manila A Manila ABC
Manila B Sydney 123
Sydney 1 New York ABC
Sydney 2
Manila C
New York A
New York B
Sydney 3
New York C


I need to actually have the Region Summary on a separate column but still keep
the Region column, for instance my data is in cells A1 to A6, then I'm going to
summarize the data to column...please help  me on this...thanks..

First sort the data. You can record that and then add the code  to the top of
the Sub.

Alter the bottom part to go to the cell where you want the data output  to.
Otherwise, go to sheet 2 and copy paste the data to where you want it.

Range("a4").Select
For ilUBound = 0 To UBound(slSummary)
ActiveCell.Value = slSummary(ilUBound)
ActiveCell.Offset(1, 0).Select
Next ilUBound
Range("a1").Select

Also, are those items at the end... A B C... single items? That is should
they be seperate in the output? I've put commas between the items but that
can be easilly changed.

The line
slValue = slValue & slSplit(1) & ","
should also be altered to
slValue = slValue & slSplit(UBound(slSplt)) & ","
to take care of items like "New York".

the code  is working...but haven't got the right output..
the prob is i need to create a new column  out of the given data but still keep
the old data.
something like this:

Region(DATA) Region Summary(output)
Manila A Manila ABC
Manila B Sydney 12
Manila C
Sydney 1
Sydney 2

I need to actually have the Region Summary on a separate column but still keep
the Region column, for instance my data is in cells A1 to A6, then I'm going to
summarize the data to column...please help  me on this...thanks..