Results 1 to 5 of 5
  1. #1
    New Lounger
    Join Date
    Oct 2013
    Posts
    23
    Thanks
    3
    Thanked 0 Times in 0 Posts

    Set rows to column

    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.

  2. #2
    New Lounger
    Join Date
    Feb 2014
    Posts
    6
    Thanks
    0
    Thanked 0 Times in 0 Posts
    You can do it by copying all your data and then using paste special...tick the transpose box

  3. #3
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    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

  4. #4
    New Lounger
    Join Date
    Oct 2013
    Posts
    23
    Thanks
    3
    Thanked 0 Times in 0 Posts
    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:\Users\fjohan\Desktop\formatedlist.pdf"
    End Sub

  5. #5
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    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:\Users\fjohan\Desktop\formatedlist.pdf"
      End With
    End Sub
    Steve

  6. The Following User Says Thank You to sdckapr For This Useful Post:

    fjohan (2014-02-20)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •