Multiple columns into rows Closed

Question

Hello, 

Can someone please give me some guidance on how I can do this?

Let say I have:

Sheet1 :

usergroup	a							
user	xx1	xx2	xx3	xx4	xx5	xx6	xx7	xx8
usergroup	b							
user	bb1	bb2	bb3	bb4	bb5	

and I want it to be

Sheet2:


usergroup	user
a	xx1
a	xx2
a	xx3
a	xx4
a	xx5
a	xx6
a	xx7
a	xx8
b	bb1
b	bb2
b	bb3
b	bb4
b	bb5


Much and much appreciated if someone can help.

thank you 
Vi
Configuration: Windows XP / Safari 533.4

rizvisa1 · Answer

Try this
It is assuming that
the two sheets are called sheet1 and sheet2

sheet2 headers are already set

data is to be copied from sheet1 to sheet2


Sub ShiftAround()
Dim Cell As Range
Dim lSheet1Row As Long
Dim lSheet2Row As Long

Dim lRow As Long
Dim iCol As Integer

    Set Cell = Cells.Find("*", Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    
    If Cell Is Nothing Then Exit Sub
    
    lSheet1Row = Cell.Row
    
    For lRow = 1 To lSheet1Row
        
        Sheets("Sheet1").Select
        ' CHECK IF THE ROW IS ODD
        If (lRow Mod 2 = 1) Then
        
            sValue = Cells(lRow, "B")
            
        'CHECK IF THE ROW IS NOT NULL (BY DEFAUL MUST BE ALSO EVEN)
        ElseIf (Cells(lRow, "A") <> "") Then
            
            iCol = Cells(lRow, Columns.Count).End(xlToLeft).Column
            Range(Cells(lRow, 2), Cells(lRow, iCol)).Copy
            
            Sheets("Sheet2").Select
            
            lSheet2Row = Cells(Rows.Count, "A").End(xlUp).Row
            
            lSheet2Row = lSheet2Row + 1
            
            Range("B" & lSheet2Row).PasteSpecial Transpose:=True
            
            Range("A" & lSheet2Row & ":A" & Cells(Rows.Count, "B").End(xlUp).Row).Value = sValue
        
        End If
    
    Next lRow

    Set Cell = Nothing
End Sub

Multiple columns into rows

1 response

Similar discussions

Subscribe To Our Newsletter!