Concatenate With Loop Through 2 Columns of Information

Maybe:

Sub nigelld()
Dim i As Long
For i = Range("B" & Rows.count).End(3)(1).Row To 2 Step -1

    If Range("A" & i).Value <> "" Then
        Range("A" & i).offset(1, 1).Cut Range("A" & i).offset(, 1)
        Rows(i + 1).Delete
    End If
Next i
End Sub

Although I'm eternally grateful for all help I can't get that bit of code to concatenate all the numbers, it just takes the first one and deletes it and I need all the numbers below the name, if any, and before the next blank cell adjacent to the next name to be in the adjacent cell to the name. Sorry ;-)

Can you attach a file with some sample data. Preferably with a Sheet before the macro is run, and a Sheet with what you want it too look like after the macro is run. To attach a file, push the button with the paperclip (or scroll down to the Manage Attachments button), browse to the required file, and then push the Upload button.