try this but make sure that sheet 5 is clear first: 
Sub blah()
With Sheets("Sheet5")
  For Each cll In Sheets("Sheet1").Range("B3:Y3").Cells
    Set Destn = .Cells(2, cll.Column * 2 - 3)
    Sheets("Sheet1").Range(cll, cll.End(xlDown)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Destn, Unique:=True
    With .Sort
      .SortFields.Clear
      .SortFields.Add Key:=Destn, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
      .SetRange Range(Destn, Destn.End(xlDown))
      .Header = xlNo
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
  Next cll
End With
End Sub