Transpose column sections into sequential rows of new sheet, Macro help

**ImmunoNut** · 05-10-2012, 07:46 PM

Hey guys,

I would appreciate some help so I can import data into a statistics program.

I need to transpose every three cells of a column into sequential rows of a new sheet.

Specifically, for columns 3-49 I need to create a new sheet named after the text of row 1 of each column. Then, for each new sheet, I need to transpose every three cells from the column it was named after into sequential rows. In other words, I need to tranpose the cells in rows 2-4 of that col, into a row in the new sheet, then cells 5-7 all the way to row 283.

Thank you for any hope in advance.

**JBeaucaire** · 05-10-2012, 09:25 PM

This should do it:

Option Explicit

Sub ColumnsToSheets()
Dim ws As Worksheet, MyRNG As Range
Dim Rw As Long, NR As Long, Col As Long

With ActiveSheet
    Application.ScreenUpdating = False
    For Col = 3 To 49
        If Len(.Cells(1, Col)) > 0 Then                                 'cell isn't blank in row1
            If Not Evaluate("ISREF('" & .Cells(1, Col) & "'!A1)") Then  'sheet doesn't already exist
                Sheets.Add(after:=Sheets(Sheets.Count)).Name = .Cells(1, Col)   'create sheet
                NR = 1                                                  'set first row to add into
                For Rw = 2 To .Cells(.Rows.Count, Col).End(xlUp).Row Step 3   'copy data, set next row
                    Range("A" & NR).Resize(, 3).Value = WorksheetFunction.Transpose(.Cells(Rw, Col).Resize(3))
                    NR = NR + 1
                Next Rw
                Columns.AutoFit
            End If
        End If
    Next Col
    .Activate
    Application.ScreenUpdating = True
End With

End Sub