Excel 2010: Moving cell right & up from original location (Offsetting it) - excel

Question

Program: Excel 2010
Experience Basic
Issue:
I have a large table of data with some "split cells" (first/last name & currency), this is how it is from the original data (copied & pasted from a webpage, the data is split in 2). I need to make a clean table with all data on 1 row, not 2. I have some sample data below, and then further down I have included how I want it to look like.
The original formatting is a HTML table, pulled from a database (which I do NOT have access to, however I can generate a CSV but that in itself is another question due to how it is setup.)
Assume: Data in (A1); there are more than the listed values & columns, and I will accept either formula OR VBA answers and lastly: Ignore the blank rows, they were inserted to show the difference between tables more clearly.
Original Data:
| Date | Transaction ID | Order Reference | Sender | Sender Email | Status | Payment Amount | Amount Paid |
|------------|----------------|-----------------|--------|--------------|--------|----------------|-------------|
| 17/04/2014 | transid | order | first | email | Paid | 5 | 5 |
| | | | last | | | AUD | AUD |
| | | | | | | | |
| 13/04/2014 | transid | order | first | email | Paid | 5 | 5 |
| | | | last | | | AUD | AUD |
| | | | | | | | |
| 13/04/2014 | transid | order | first | email | Paid | 5 | 5 |
| | | | last | | | AUD | AUD |
| | | | | | | | |
| 12/04/2014 | transid | order | first | email | Paid | 5 | 5 |
| | | | last | | | AUD | AUD |
Required Data: (notice the first/last are now on the same row as is the currency)
| Date | Transaction ID | Order Reference | Sender | | Sender Email | Status | Payment Amount | | Amount Paid | |
|------------|----------------|-----------------|--------|------|--------------|--------|----------------|-----|-------------|-----|
| 17/04/2014 | transid | order | first | last | email | Paid | 5 | AUD | 5 | AUD |
| | | | | | | | | | | |
| 13/04/2014 | transid | order | first | last | email | Paid | 5 | AUD | 5 | AUD |
| | | | | | | | | | | |
| 13/04/2014 | transid | order | first | last | email | Paid | 5 | AUD | 5 | AUD |
| | | | | | | | | | | |
| 12/04/2014 | transid | order | first | last | email | Paid | 5 | AUD | 5 | AUD |
Thank you, have a great weekend.
[EDIT]
Note, none of these cells are merged, each cell is an individual, and the "last" & "AUD" need to be moved right & up.

Answer 1

This should work for you:
Public Sub ModData()
Dim colDate As Long
Dim colTrans As Long
Dim colOrder As Long
Dim colSender As Long
Dim colSenderEmail As Long
Dim colStatus As Long
Dim colPmtAmt As Long
Dim colPaid As Long
Dim r As Long
Dim ws As Worksheet
colDate = 1
colTrans = 2
colOrder = 3
colSender = 4
' col 5 reserved for inserted col
colSenderEmail = 6
colStatus = 7
colPmtAmt = 8
' col 9 reserved for inserted col
colPaid = 10
Set ws = ActiveSheet
Application.ScreenUpdating = False
' Add extra columns needed.
ws.Columns(colSender + 1).Insert Shift:=xlToRight
ws.Columns(colPmtAmt + 1).Insert Shift:=xlToRight
' Move data to same row.
For r = 2 To 12 Step 2
ws.Cells(r, colSender + 1).Value = ws.Cells(r + 1, colSender).Value
ws.Cells(r, colPmtAmt + 1).Value = ws.Cells(r + 1, colPmtAmt).Value
ws.Cells(r, colPaid + 1).Value = ws.Cells(r + 1, colPaid).Value
Next r
' Delete unnecessary rows.
r = 3
While ws.Cells(r - 1, 1).Value <> ""
ws.Cells(r, 1).EntireRow.Delete
r = r + 1
Wend
Application.ScreenUpdating = True
End Sub