Thread: How to convert data from vertical to horizontal

Run this macro on your data, as long as it is exactly in the layout shown:

Option Explicit

Sub ReformatData()
Dim RNG As Range, r As Long

Application.ScreenUpdating = False
Set RNG = Range("A:A").SpecialCells(xlConstants)

For r = 1 To RNG.Areas.Count
    Range("B" & RNG.Areas(r).Cells(1).Row).Resize(6).Copy
    Range("U" & RNG.Areas(r).Cells(1).Row - 1).PasteSpecial xlPasteValues, Transpose:=True
    Range("D" & RNG.Areas(r).Cells(1).Row).Resize(7).Copy
    Range("AA" & RNG.Areas(r).Cells(1).Row - 1).PasteSpecial xlPasteValues, Transpose:=True
    Range("F" & RNG.Areas(r).Cells(1).Row).Resize(10).Copy
    Range("AH" & RNG.Areas(r).Cells(1).Row - 1).PasteSpecial xlPasteValues, Transpose:=True
Next r

Range("G:G").SpecialCells(xlBlanks).EntireRow.Delete xlShiftUp
Range("A:E").Delete xlShiftToLeft
Rows(1).Insert xlShiftDown

For r = 1 To 38
    Cells(1, r) = "Title " & r
Next r
Range("A1").Select
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 (.xlsm)

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

Hi tiggi and JB

This is just a test as the thread has zero replies but observably JB has posted??