Sub NamesData_v2()
'
'Prg : NamesData_v2
'Author : Markmzz
'Date : 25/05/2011
'Version: 02
'
'Explicitly defines the variables
Dim LastRowL1, LastRowL2, LastColL1, NextCol As Long
Dim RL1, RL2, CL1, CL2, NCL1, NCL2, CCL2 As Long
Dim NameList2 As String
'Disable screen updating
Application.ScreenUpdating = False
'Determines the number of rows of the first list
LastRowL1 = Cells(Rows.Count, 1).End(xlUp).Row
'Determines the number of columns of the first list
LastColL1 = Cells(1, Columns.Count).End(xlToLeft).Column
'Determines the number of columns with
'Name column out of the first list
NCL1 = LastColL1 - 1
'Sort, in ascending order, the 1st list
Range(Cells(2, 1), Cells(LastRowL1, LastColL1)).Sort _
Key1:=Range("A2"), _
Order1:=xlAscending
'Initial Column of the 2nd list
NextCol = LastColL1 + 2
'Create one sort list of unique names (list 2)
Range(Cells(1, 1), Cells(LastRowL1, 1)).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range(Cells(1, NextCol).Address), _
Unique:=True
Cells(1, NextCol).Font.Bold = False
'Determines the number of rows from the second list
LastRowL2 = Cells(Rows.Count, NextCol).End(xlUp).Row
'Define two with the current Row in the 1st list
RL1 = 2
'Navigate by Names of the 2nd list
For RL2 = 2 To LastRowL2
'Show the progress in the Status Bar of the Excel
Application.StatusBar = "Processing row " & RL2 & " of " & LastRowL2
'Store the current Name of the 2nd list
NameList2 = Cells(RL2, NextCol).Value
'Define NextCol+1 with the current Column in the 2nd list
CL2 = NextCol + 1
'Navigate by Names in the 1st list that are equal
'the current Name in the 2nd lists
Do While Cells(RL1, 1) = NameList2
'Fill, in the 2nd list, the data of the current name
For CL1 = 2 To LastColL1
Cells(RL2, CL2).Value = Cells(RL1, CL1).Value
'Add one to the counter of the current Column in the 2st list
CL2 = CL2 + 1
Next CL1
'Add one to the counter of the current Row in the 1st list
RL1 = RL1 + 1
Loop
Next RL2
'Determines the number of columns (Col2, Col3,...) in 2nd List
NCL2 = (Cells(1, NextCol).CurrentRegion.Columns.Count - 1) / NCL1
'Fill the labels of columns of 2nd List
For CCL2 = 1 To NCL2
For CL1 = 2 To LastColL1
Cells(1, (CCL2 - 1) * NCL1 + NextCol + CL1 - 1).Value = _
Cells(1, CL1).Value
Next CL1
Next CCL2
'Autofit the columns of 2nd List
Cells(1, NextCol).CurrentRegion.EntireColumn.AutoFit
'Enable screen updating
Application.ScreenUpdating = True
'Reset the Status Bar of the Excel
Application.StatusBar = False
End Sub
