Sub Button2_Click()
Dim dlg as integer
With Sheets("Database")
dlg = .Range("A" & .Rows.Count).End(xlUp).Row + 1
ActiveSheet.Range("D2:D6,D8:D12,D14:D17").Copy
.Range("A" & dlg).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=True
.Sort.SortFields.Clear
.Sort.SortFields.Add2 Key:=.Range("A2:A" & dlg), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With .Sort
.SetRange Sheets("Database").Range("A2:N" & dlg)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
ActiveSheet.Range("D2:D6,D8:D12,D14:D17").ClearContents
End Sub