Set rows to column

Topic

New Reply

Hello,

I want set the rows to column along with headers Like from Column A to I i want to set column A to C then D to F and G to I
I have attached the workbook along with the desired result.
Any helps.

Reply | Quote

Replies

You can do it by copying all your data and then using paste special…tick the transpose box

Reply | Quote

Try this code, It transforms the “sheet1” to the “Results”.

Code:

Option Explicit
Sub TransformData()
  Dim wOri As Worksheet
  Dim wNew As Worksheet
  Dim rHead(1 To 3) As Range
  Dim x As Integer
  Dim lLastRow As Long
  Dim lRowOri As Long
  Dim lRowNew As Long
    
  'Set things for original sheet
  Set wOri = ActiveSheet
  With wOri
    Set rHead(1) = .Range("A1:C1")
    Set rHead(2) = .Range("D1:F1")
    Set rHead(3) = .Range("G1:I1")
    lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
  End With
   
  'Create transformed sheet
  Set wNew = Worksheets.Add
  lRowNew = 1
  With wNew
    'set column widths
    .Columns("A:A").ColumnWidth = 12.43
    .Columns("B:B").ColumnWidth = 13.43
    .Columns("C:C").ColumnWidth = 23.86
    For lRowOri = 2 To lLastRow
      'copy each 1 third of the the data
      For x = 1 To 3
        rHead(x).Copy .Cells(lRowNew, 1)
        rHead(x).Offset(lRowOri - 1, 0).Copy .Cells(lRowNew + 1, 1)
        lRowNew = lRowNew + 3
      Next
      'Add the borders
      With .Range(.Cells(lRowNew - 1, 1), _
        .Cells(lRowNew - 1, 3)).Borders(xlEdgeTop)
          .LineStyle = xlContinuous
          .ColorIndex = 0
          .TintAndShade = 0
          .Weight = xlThin
      End With
      With .Range(.Cells(lRowNew - 1, 1), _
        .Cells(lRowNew - 1, 3)).Borders(xlEdgeBottom)
          .LineStyle = xlContinuous
          .ColorIndex = 0
          .TintAndShade = 0
          .Weight = xlThin
      End With
    Next
  End With
End Sub

Steve

Reply | Quote

Hi Steve,

It creates the transform sheet superbly, Thanks.

One last thing i export this sheet to .pdf format how to set this sheet to A4 size with 3 sets in each sheet.

Code:

Sub export()
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=”C:UsersfjohanDesktopformatedlist.pdf”
End Sub

Reply | Quote

How about this?

Code:

Option Explicit
Sub export()
  Dim lRow As Long
  Dim lLastRow As Long
  With ActiveSheet
    .PageSetup.PaperSize = xlPaperA4
    lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    .ResetAllPageBreaks
    For lRow = 28 To lLastRow Step 27
      .HPageBreaks.Add before:=.Cells(lRow, 1)
    Next
    .ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:="C:UsersfjohanDesktopformatedlist.pdf"
  End With
End Sub

Steve

Reply | Quote