Sleeper: Transpose every line

[john]

Hi,

Could anyone help me how to transpose the following as given below? Can it be done by a VBA?

Anthony|marketing|malaysia|Asia
Paul|marketing|Tokya|Asia
Steve|Admin|Paris|Europe
........................
........................ (upto 3000 lines)

I want the above input to change as below:

Anthony
marketing
malaysia
Asia
paul
marketing
Tokyo
Asia
Steve
Admin
Paris
Europe

The transpose will execute for everyline and the output should be in one column. Could anyone help me?

[Jacob Hilderbrand]

This macro will traspose all data in Col B through IV to Col A:


Option Explicit

Sub TransposeData()
Dim x As Long
Dim LastRow As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
Range("A2:A65536").ClearContents
LastRow = Range("B65536").End(xlUp).Row
For x = 1 To LastRow
Range("B" & x & ":IV" & x).Copy
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Next x
Range("A1").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub


Change the starting value of x to the first row with data. To start with row 2 use this line:


For x = 2 To LastRow

[Shrout1]

Might a workbook.usedrange.columns(2) be a little more efficient?

Workbook.usedrange.columns(2).select?

[Zack Barresse]

How about just select your data (B1:lastCol 1), copy, select desired row in A, paste special -> Transpose

[Jacob Hilderbrand]

Might a workbook.usedrange.columns(2) be a little more efficient?

Workbook.usedrange.columns(2).select?UsedRange is actually less efficient since Excel forgets what its "Used Range" really is frequently.

[Jacob Hilderbrand]

How about just select your data (B1:lastCol 1), copy, select desired row in A, paste special -> Transpose
For 3000 rows? One at a time? :eek:

[mdmackillop]

Apparently it takes 180 repetitions of muscular movement for it to be "remembered" by the brain. After the first 1000, he should be going pretty fast!!!
MD

[Jacob Hilderbrand]

:rofl

[john]

Hi Jacob,

Thanks a lot. It's working excellent.
I need a slight change in the output format. In the attached spradsheet, there are 2 sheets one is input, the other is output in a particular format.

Actually I am having around 25 columns, in that only transpose should occur for only 4 columns(columns highlightened), other columns should retain the same value with the transposed column. Could it be possible?

Thanks
John

[Jacob Hilderbrand]

Try this:


Option Explicit

Sub TransposeData()
Dim x As Long
Dim y As Long
Dim LastRow As Long
Dim Col1 As String
Dim Col2 As String
Dim Col3 As String
Dim Col4 As String
Dim StartRow As Long
Dim EndRow As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
LastRow = Sheets("Input").Range("A65536").End(xlUp).Row
For x = 1 To LastRow
With Sheets("Input")
Col1 = .Range("A" & x).Text
Col2 = .Range("B" & x).Text
Col3 = .Range("G" & x).Text
Col4 = .Range("H" & x).Text
.Range("C" & x & ":F" & x).Copy
End With
With Sheets("Output")
StartRow = .Range("C65536").End(xlUp).Row + 1
.Range("C" & StartRow).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=True
EndRow = .Range("C65536").End(xlUp).Row
For y = StartRow To EndRow
.Range("A" & y) = Col1
.Range("B" & y) = Col2
.Range("D" & y) = Col3
.Range("E" & y) = Col4
Next y
End With
Next x
Range("A1").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub