Friends
I want to transpose the variable columns to single column in the next page like
Original
A1,A2,A3,A4
B1,B2,B3
C1,C2,C3,C4,C5
...
To next page 'Final' like
A1
A2
A3
A4
B1
B2
B3
C1
C2
C3
C4
C5
...
One by one
Normal transpose doesn't work for me.
Thx in advance
Are those the actual ranges you want to copy to "Final"? If not, please clarify.
You could try this. Change references where required.
Sub Maybe()
Dim i As Long, sh1 As Worksheet, sh2 As Worksheet, j As Long, a
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Final")
For i = 2 To sh1.Cells(Rows.Count, 1).End(xlUp).Row
a = Split(Cells(i, 1), ",")
For j = LBound(a) To UBound(a)
sh2.Cells(Rows.Count, 1).End(xlUp).Offset(1) = Trim(a(j))
Next j
a = ""
Next i
End SubI think this is what you want to do, the code could be more efficient if bypassing the clipboard copyandpaste, but I am not sure how to do the transpose in that case.
Sub MultiTrsp()
Dim MyCount As Long, i As Long, LstRW As Long, MyPRW As Long, MyLstCOL As Long
Dim ws1 As Worksheet: Set ws1 = Sheet1
Dim ws2 As Worksheet: Set ws2 = Sheet2
MyCount = ws1.Cells(1, 1).CurrentRegion.Rows.Count
MyPRW = ws2.Cells(1, 1).CurrentRegion.Rows.Count + 1
If MyPRW = 2 And ws2.Cells(1, 1) = vbNullString Then MyPRW = 1
MsgBox MyPRW
For i = 1 To MyCount
MyLstCOL = ws1.Cells(i, Columns.Count).End(xlToLeft).Column
ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, MyLstCOL)).Copy
ws2.Cells(MyPRW, 1).PasteSpecial Transpose:=True
MyPRW = ws2.Cells(1, 1).CurrentRegion.Rows.Count + 1
Next i
Application.CutCopyMode = False
End SubRegards
Justin
You should also put:
Application.ScreenUpdating = Falsein line 2 or 3
Justin
You don't need to switch off ScreenUpDating if you don't select the sheets. If you do then you must switch it back on again. Try this
Option Explicit
Sub RowsToColumns()
Dim rData As Range
Dim lRw As Long, lNextRw As Long
Set rData = Sheet1.Range("A1").CurrentRegion
Set rData = rData.Offset(1).Resize(rData.Rows.Count - 1, rData.Columns.Count)
For lRw = 1 To rData.Rows.Count
With Sheet2
lNextRw = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
''/// this is not necessary if the destination sheet has a header row
If lNextRw = 2 Then lNextRw = 1
rData.Rows(lRw).Copy
.Cells(lNextRw, 1).PasteSpecial Transpose:=True
End With
Next lRw
End SubAn alternative solution is to use Power Query. Load your range to PQ. Highlight all columns and click on Unpivot. The Mcode follows
let
Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
#"Changed Type" = Table.TransformColumnTypes(Source,{{"Column1", type text}, {"Column2", type text}, {"Column3", type text}, {"Column4", type text}, {"Column5", type text}}),
#"Unpivoted Columns" = Table.UnpivotOtherColumns(#"Changed Type", {}, "Attribute", "Value"),
#"Removed Columns" = Table.RemoveColumns(#"Unpivoted Columns",{"Attribute"})
in
#"Removed Columns"OMG to fast replies and helping intentions!
Thanks to all the top experts....
Thank you you all
jolivanes, Justin Doward & Royuk
Thx for taking interest
Mumps, AlanSidman
Pleased to help.
Don’t have an account yet? Register yourself now and be a part of our community!