Sorting data in the sheet

[gesaugen]

I'm trying to sort data from online contacts book. Problem is that after importing data, some imputs have two or three rows because of additional phone or telefax number and those rows are written one under another. Other problem is that another column with the address is after import used for both address and workplace name. Looks like this (... are blanks):
Col1.../ Col2..../ Col3..../
Name1/ Phone1/ workplace1
Name2/ Phone1/ Workplace2
........./ Phone2/ Address

And I would like it to be:
Col1.../ Col2..../ Col3........./ Col4...../ Col5...../
Name1/ Phone1/ workplace1/.........../.........../
Name2/ Phone1/ workplace2/ Phone2/ Address/

[dflak]

Attach a sample workbook so we can better visualize the data. Thanks.

[GeoffW283]

some imputs have two or three rows

Your desired result does not specify the column layout where there are three rows worth of data for a given name.

[GeoffW283]

Here's a VBA solution.

Assumes source data is in cols A:C starting at A1

Execute the "rearrange" macro.

The re-arranged data starts at E1

See the attached workbook

Here's the VBA:

'Reorganize imported data
'Consolidate row data when the name in column-A is blank
'Assume columns A:C starting at A1 contains the imported data
'Assume the output data starts at cell E1
Sub rearrange()
    Dim OutRng As Range, InRng As Range
    Dim inrow As Integer, outrow As Integer 'input and output row counters
    Set InRng = ActiveSheet.Range("A1")
    Set OutRng = ActiveSheet.Range("E1")
    inrow = 1
    outrow = 1
    'loop around all imported data
    While inrow <= ActiveSheet.UsedRange.Rows.Count
        OutRng.Cells(outrow, 1) = InRng.Cells(inrow, 1)
        OutRng.Cells(outrow, 2) = InRng.Cells(inrow, 2)
        OutRng.Cells(outrow, 3) = InRng.Cells(inrow, 3)
        inrow = inrow + 1
        'If the name column is blank then append data to the same output row
        If (IsEmpty(InRng.Cells(inrow, 1))) Then
            OutRng.Cells(outrow, 4) = InRng.Cells(inrow, 2)
            OutRng.Cells(outrow, 5) = InRng.Cells(inrow, 3)
            inrow = inrow + 1
        End If
        'A second blank name row - append data to the same output row
        If (IsEmpty(InRng.Cells(inrow, 1))) Then
            OutRng.Cells(outrow, 6) = InRng.Cells(inrow, 2)
            OutRng.Cells(outrow, 7) = InRng.Cells(inrow, 3)
            inrow = inrow + 1
        End If
        outrow = outrow + 1
    Wend
End Sub