Transposing multiple rows into one row

Give this a try. It assumes the headers are in row1 and the data starts in row2.

Option Explicit

Sub MergeUP()
Dim a As Long, i As Long
Dim LR As Long, Rw As Long, rngDEL As Range

Application.ScreenUpdating = False
ActiveSheet.Copy
LR = Range("A" & Rows.Count).End(xlUp).Row
Set rngDEL = Range("A" & LR + 1)
For Rw = LR To 3 Step -1
    If Range("A" & Rw - 1) <> "" Then
        Range("A" & Rw).Resize(, 200).Copy Cells(Rw - 1, Columns.Count).End(xlToLeft).Offset(, 1)
        Set rngDEL = Union(rngDEL, Range("A" & Rw))
    End If
Next Rw

rngDEL.EntireRow.Delete xlShiftUp
LR = Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Range("A1:D1").Copy Range("I1", Cells(1, LR))
Columns.AutoFit
Application.ScreenUpdating = True

End Sub

How/Where to install the macro:

1. Open up your workbook
2. Get into VB Editor (Press Alt+F11)
3. Insert a new module (Insert > Module)
4. Copy and Paste in your code (given above)
5. Get out of VBA (Press Alt+Q)
6. Save as a macro-enabled workbook

The macro is installed and ready to use. Press Alt-F8 and select it from the macro list.