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

[Maria]

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?

[Jess]

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 
    ws.Range("A1").CurrentRegion.ClearContents 
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 
            Else 
                Exit For 
            End If 
        Next 
    Next 
End If 
Set ws = Nothing 
Set rng = Nothing

Jess

[Bob Phillips]

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")
 
    ws2.UsedRange.ClearContents

    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