Transponse help

Can I speed up this process, not a problem for a couple of people, but if there is 150+ any help is welcome

As you can see in the pictures to get a result on the sheet 2 had to:

1. copy from sheet 1 paste special into new sheet (marked Transpose option)
2. select all cell with data and make degrees to 0
3. double center cells, modify cell to bold, font size etc...
4.repeat all for second person etc etc..

Is there any VBA or Macro to have this prosses automatically as I write data from one sheet to get a result on the sheet 2

Here is dropbox with an example workbook link...

https://www.dropbox.com/s/ka2qvilazc...test.xlsx?dl=0

you can post your workbook here.

Go Advanced
Manage Attachments
Add Files
Select Files
Open
Upload Files
Done

Files for Transpose help

thanks snb for getting me into the habit of using index function with arrays.



that said, below will handle 1st and 4th steps.

2nd and 3rd not clear to me.
since they are about formatting, record a macro while manually formatting the cells in Columns A and B of sheet List2. then post your recorded macro here so we can insert/adopt it to below code.

try this code with a copy of your file.

Code:

---

Sub vbax_54847_Create_Separate_Tables_Each_Row_Transposed()
'http://www.vbaexpress.com/forum/showthread.php?54847-Transponse-help

    Dim j As Long, k As Long
    Dim pList

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
   
    Worksheets("List1").Copy After:=Worksheets(Worksheets.Count)
   
    With ActiveSheet
        .Rows(1).Delete
        .UsedRange.Rows(1).SpecialCells(xlCellTypeBlanks) = Chr(10)
        pList = Application.Transpose(.Cells(1).CurrentRegion.Value)
        .Delete
    End With
   
    k = 1
    With Worksheets("List2")
        .Cells.Clear 'clear existing data
        For j = 2 To UBound(pList, 2)
            .Cells(1, k).Resize(UBound(pList)).Value = Application.Index(pList, , 1)
            .Cells(1, k + 1).Resize(UBound(pList)).Value = Application.Index(pList, , j)
            k = k + 3
        Next
    End With
End Sub

---

PS: a table's top left cell must be A1 and first column (generally record id's) and first row (headers or field names) must contain no blank cells. below line inserts a non printinting character into blank cells in the header row. i chose Chr 10.

Code:

---

.UsedRange.Rows(1).SpecialCells(xlCellTypeBlanks) = Chr(10)

---

Thank you Mancubus
--------------------------------
2nd and 3rd not clear to me.
since they are about formatting, record a macro while manually formatting the cells in Columns A and B of sheet List2. then post your recorded macro here so we can insert/adopt it to below code.
_________________________

Here is a YouTube link that basically explains what I'm doing

With slight modifications code works what I needed and for details using Format Painter.

Thank you.

Problem Solved? Use Thread Tools above the thread to mark it.