Results 1 to 3 of 3

Thread: Transpose row's of data & when blank move on to next row

  1. #1

    Transpose row's of data & when blank move on to next row

    Register for a FREE account, and/
    or Log in to avoid these ads!

    I have several rows of data of varying lengths. I need to take each row of data, transpose it to a new sheet, so the data is in a single column. Then transpose the next row of data directly under that. This process needs to be automatic, so when excel gets to the end of the row(e.g (value = 0) it knows to move on to the next row & start populating that data. When two rows return a zero value the formula / loop should stop.

    Any ideas?

  2. #2
    Neophyte Jess's Avatar
    Join Date
    May 2011
    Huntingdon Cambridgeshire England
    Hello Maria

    On the assumption that your data is in a contigious range (no blank rows or columns) and there a no blank cells in any row of data, the following may be a good starting point for you:

    Worksheets("Sheet1").Activate 'Worksheet containing data.
    Set ws = Worksheets("Sheet2") 'Destination worksheet.
     'Clear destination existing data.
    If ws.Range("A1").Value <> "" Then 
    End If 
    iRows = 1 
     'Reference Sheet1 data range.
    Set rng = Range("A1").CurrentRegion 
    If Not rng Is Nothing Then 
        For r = 1 To rng.Rows.Count 
            For c = 1 To rng.Columns.Count 
                If Cells(r, c) <> vbNullString Then 
                    With ws 
                        .Cells(iRows, 1) = Cells(r, c).Value 
                        iRows = iRows + 1 
                    End With 
                    Exit For 
                End If 
    End If 
    Set ws = Nothing 
    Set rng = Nothing
    Last edited by Simon Lloyd; 2011-08-07 at 07:02 PM. Reason: Code layout, added code tags and indented code

  3. #3
    Super Moderator Bob Phillips's Avatar
    Join Date
    Mar 2011
    Excel Version
    An alternative

    Sub TransformData()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lastrow As Long
    Dim lastcol As Long
    Dim nextrow As Long
    Dim i As Long
        Set ws1 = Worksheets("Sheet1")
        Set ws2 = Worksheets("Sheet2")
        With ws1
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            nextrow = 1
            For i = 1 To lastrow
                lastcol = .Cells(i, .Columns.Count).End(xlToLeft).Column
                .Cells(i, "A").Resize(, lastcol).Copy
                ws2.Cells(nextrow, "A").PasteSpecial Paste:=xlPasteAll, Transpose:=True
                nextrow = nextrow + lastcol
            Next i
        End With
    End Sub

Tags for this Thread

Posting Permissions

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