View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Joergen Bondesen Joergen Bondesen is offline
external usenet poster
 
Posts: 110
Default row to column converter

Hi khaldouz

Try belowe please.


Option Explicit
Const hil As String = "Best regards from Joergen Bondesen"

'----------------------------------------------------------
' Procedure : TransposeRows
' Date : 20060716
' Author : Joergen Bondesen
' Modifyed by :
' Purpose : Transpose rows to 2 Columns.
' Data is starting in A1.
' First cell (Column A) will always be in new
' Column A and next cell(s) in row will be
' transposed to new Coloum B.
' A1 is now C1.
' If next cell in rows is empty, new Column
' B is empty
' K,B,R =
' K,B
' K,R etc.
' Note : Existing data will NOT be deleted.
' Sheet with Transpose Data, must be
' Activesheet.
' Sheet contains only TransposeData.
'----------------------------------------------------------
'
Sub TransposeRows()
Dim Lastrow As Long
Dim TransposeRange As Range
Dim cell As Range
Dim LastCol As Long
Dim Rowrange As Range
Dim cellr As Range
Dim x As Long

'// Sure to transpose
If MsgBox("Sure to 'Transpose'?", vbCritical + _
vbYesNo + vbDefaultButton2, hil) = vbNo Then
End
End If

'// Speed
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'// Insert 2 columns
Columns("A:B").Insert Shift:=xlToRight

'// Range determine
'// Lastrow
Lastrow = Cells(Rows.Count, 3).End(xlUp).Row
Set TransposeRange = Range("C1:C" & Lastrow)

For Each cell In TransposeRange
LastCol = Cells(cell.Row, Columns.Count) _
.End(xlToLeft).Column

If LastCol = 3 Then LastCol = 4

Set Rowrange = cell.Offset(0, 1).Resize(1, LastCol - 3)

For Each cellr In Rowrange
x = x + 1
Cells(x, 1).Value = cell.Value
Cells(x, 2).Value = cellr.Value
Next cellr
Next cell

'// Reset
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Set TransposeRange = Nothing
Set Rowrange = Nothing
End Sub


--
Best Regards
Joergen Bondesen


"khaldouz" wrote in
message ...

hi,
can any one provide a macro or formula to converT row to column as in
the example below:.
FROM
A B1 K1 C1
B KI GI M1 H1

TO

A B1
A K1
A C1
B K1
B G1
B M1

Thank you


--
khaldouz
------------------------------------------------------------------------
khaldouz's Profile:
http://www.excelforum.com/member.php...o&userid=36406
View this thread: http://www.excelforum.com/showthread...hreadid=561824