Transposing columns to rows

[MosheMo]

Hello,

I am asking this question on behalf of my father. He has a spreadsheet of
data which is about 2000 rows long and 9 columns wide. My dad wants to
transpose the data in columns B - I in the following manner:

The data in B1 will move into cell A2 (and the data in A2 will move down to
A3). The data in C1 will move into cell A3 (and the data in A3 will move
down to A4).
And so on until I1 becomes A9 and the data in A9 moves over to A10.
This happens row after row - i.e., B2 becomes A11; C2 A12, etc. for all
2,000 rows.

Any ideas how this can be down?

Thanks and be well,

Moshe

 

[Tom Hutchins]

Try this macro. It assumes the data in column A is in contiguous rows. If
it's not, let me know (via this thread) and I will send a revised version.

Sub Macro1()
Dim CurrRow As Long
CurrRow = 1
Cells(CurrRow, 1).Activate
Do While Len(ActiveCell.Value) > 0
Range("A" & CurrRow + 1 & ":A" & CurrRow + 8).Select
Selection.EntireRow.Insert
Range("B" & CurrRow & ":I" & CurrRow).Select
Selection.Copy
Range("A" & CurrRow + 1 & ":A" & CurrRow + 8).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
Cells(CurrRow + 9, 1).Activate
CurrRow = ActiveCell.Row
Loop
'Delete columns B-I
Columns("B:I").Select
Selection.Delete Shift:=xlToLeft
End Sub

Paste this code in a VBA module in your workbook. If you're new to macros,
you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

Hope this helps,

Hutch

 

[MosheMo]

Hello,

Thanks for your reply. I really apprecaite it.

Unfortunately, it seems that I didn't quite understand what my father needs
(I got it mostly right, but misunderstood a crucial aspect). Let me offer
another example that is more accurate:

My Dad needs to transform this:

0116012-ZN 0116012-ZN-BM 100 RL-001 1 RLB-10 1

into this:

0116012-ZN 0116012-ZN-BM
0116012-ZN 100
0116012-ZN RL-001
0116012-ZN 1
0116012-ZN RLB-10
0116012-ZN 1
0116012-ZN RB-003
0116012-ZN 1

I.e. the product number in Column 1 gets repeated each and every row while
the information in columns 2 and upward get placed in turn in Column 2 for as
many rows as necessary (I hope that is clear - if it isn't please let me know
and I'll see if I can give a better example).

Thanks again for your help.

Yours truly,

Moshe

 

[Tom Hutchins]

Try this revised version of the macro. I believe it will do what you want.
The last two lines, which delete columns C through I, are commented out
(makes it easier to confirm that the macro performed as expected).

Sub Macro1()
Dim CurrRow As Long, LastCol As Integer
CurrRow = 1
Cells(CurrRow, 1).Activate
Do While Len(ActiveCell.Value) > 0
'Find the last used column in this row
LastCol = Cells(CurrRow, Columns.Count).End(xlToLeft).Column
If LastCol > 2 Then
'Insert enough new rows below the current row
Range("A" & CurrRow + 1 & ":A" & CurrRow + LastCol - 2).Select
Selection.EntireRow.Insert
'Copy column A cell down.
Range("A" & CurrRow).Select
Selection.Copy
Range("A" & CurrRow + 1 & ":A" & CurrRow + LastCol - 2).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
'Copy the remaining columns' cells down.
Range(Cells(CurrRow, 3), Cells(CurrRow, LastCol)).Select
Selection.Copy
Range("B" & CurrRow + 1 & ":B" & CurrRow + LastCol - 1).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
'Move to the next row.
Cells(CurrRow + LastCol - 1, 1).Activate
Else
'If only data in A or A&B, just move to next row.
Cells(CurrRow + 1, 1).Activate
End If
CurrRow = ActiveCell.Row
Loop
'Delete columns C-I
'Columns("C:I").Select
'Selection.Delete Shift:=xlToLeft
End Sub

Hope this helps,

Hutch