Range('B4:D7').Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range('D5'), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range('B4').Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Range('B11').Select
ActiveSheet.Paste