Sub sorteer()
Sheets("Sheet2").Select
Rows("1:1").Select
Selection.Find(What:="Full /Part", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Rows("1:1").Select
Selection.Find(What:="DeptID", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Rows("1:1").Select
Selection.Find(What:="City", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Rows("1:1").Select
Selection.Find(What:="Department", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Rows("1:1").Select
Selection.Find(What:="Employee Name", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Rows("1:1").Select
Selection.Find(What:="Employee ID", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 0).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
End Sub