Macor for Tranpose data

E

Elainey

i have multiple rows, each with varing numbers of columns. i need to
get it so that each columns has it own row. i have over 1000 rows
and was hoping to get a macro can transpose the data for me?? for
example:


I have something like this:
A 3 4 7
B 5 2 9 1 5


I need it to look like this:
A 3
A 4
A 7
B 5
B 2
B 9
B 1
B 5


can someone help me?! =o)
 
B

Bernie Deitrick

Ealainey,

Try the macro below. For it to work, you need a row of headers (which can be anything). Select one
cell in your data table, and run the macro. The extra column with the values from the header row
can be deleted.

HTH,
Bernie
MS Excel MVP

Sub MakeTable2()
Dim myCell As Range
Dim newSheet As Worksheet
Dim mySheet As Worksheet
Dim i As Long
Dim j As Integer
Dim k As Long
Dim l As Integer
Dim mySelection As Range
Dim RowFields As Integer

Set mySheet = ActiveSheet
Set mySelection = ActiveCell.CurrentRegion
RowFields = 1
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("New Database").Delete
Application.DisplayAlerts = True
Set newSheet = Worksheets.Add
newSheet.Name = "New Database"
mySheet.Activate
i = 1
For j = mySelection(1).Row + 1 To _
mySelection(mySelection.Cells.Count).Row
For k = mySelection(1).Column + RowFields To _
mySelection(mySelection.Cells.Count).Column
If mySheet.Cells(j, k).Value <> "" Then
For l = 1 To RowFields
newSheet.Cells(i, l).Value = _
Cells(j, mySelection(l).Column).Value
Next l
newSheet.Cells(i, RowFields + 1).Value = _
Cells(mySelection(1).Row, k).Value
newSheet.Cells(i, RowFields + 2).Value = _
Cells(j, k).Value
i = i + 1
End If
Next k
Next j

End Sub
 
Top