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
    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