Is this something you have to do frequently?
I was able to do it manually in 5 minutes by using Text-to-Columns
then copy/paste special, transform
to get it into column form, then copied the carrier
name down each column and move it into the first pair of columns.
But if you do it frequently, it can be tedious.
this macro should do it for you:
Option Explicit
Sub Traspose_Data()
Dim Rcnt, RowInx, inx, phArray, phInx, CName
Dim Sht_IN, Sht_OUT
'------------------------------------------------------
Sht_IN = "Main"
Sht_OUT = "working"
'------------------------------------------------------
Sheets(Sht_IN).Select
Sheets(Sht_OUT).Range("A2:Z65000").ClearContents
'------------------------------------------------------
' Count the number of rows in "Main" sheet
'------------------------------------------------------
Rcnt =
Application.WorksheetFunction.CountA(Sheets(Sht_IN).Range("A1:A65000"))
RowInx = 1
'------------------------------------------------------
' Loop through all data rows
'------------------------------------------------------
For inx = 2 To Rcnt
If (Sheets(Sht_IN).Cells(inx, 1).Value <> "") Then
CName = Sheets(Sht_IN).Cells(inx, 1).Value
'------------------------------------------------------
' split dial codes using "," as delimter and store in array
'------------------------------------------------------
phArray = Split(Sheets(Sht_IN).Cells(inx, 2).Value, ",")
'------------------------------------------------------
' Loop through array
'------------------------------------------------------
For phInx = 0 To UBound(phArray)
RowInx = RowInx + 1
Sheets(Sht_OUT).Cells(RowInx, 1) = CName
Sheets(Sht_OUT).Cells(RowInx, 2) = phArray(phInx)
Next phInx
End If
Next inx
'----------------------------------------
' Sort Data
'----------------------------------------
Sheets(Sht_OUT).Select
Cells.Select
ActiveWorkbook.Worksheets(Sht_OUT).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(Sht_OUT).Sort.SortFields.Add Key:=Range( _
"A2:A65000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets(Sht_OUT).Sort.SortFields.Add Key:=Range( _
"B2:B65000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets(Sht_OUT).Sort
.SetRange Range("A1:B65000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A2").Select
End Sub
Paul
________________________________
From: girish kumar <[email protected]>
To: [email protected]
Sent: Fri, August 13, 2010 5:13:14 AM
Subject: $$Excel-Macros$$ help required
can any one help me to sort out this problem
i have attached one file contains 2 sheets
in first sheet having main data, i want this data like data in working sheet in
normalised formet
friends pls set vba macro or access database for sort out this problem
regards
Girish
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to [email protected]
<><><><><><><><><><><><><><><><><><><><><><>
HELP US GROW !!
We reach over 7000 subscribers worldwide and receive many nice notes about the
learning and support from the group.Let friends and co-workers know they can
subscribe to group at http://groups.google.com/group/excel-macros/subscribe
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to [email protected]
<><><><><><><><><><><><><><><><><><><><><><>
HELP US GROW !!
We reach over 7000 subscribers worldwide and receive many nice notes about the
learning and support from the group.Let friends and co-workers know they can
subscribe to group at http://groups.google.com/group/excel-macros/subscribe
