Private Sub CommandButton1_Click()
    Dim Sh2 As Worksheet, myRng As Range, m%, n%, i&, myC As New Collection
    On Error Resume Next
    Set Sh2 = Sheet2
    i = Sh2.[F65536].End(xlUp).Row
    Sh2.Range("F1:O" & i).Sort Key1:=Sh2.Range("F2"), Order1:=xlAscending, Header:=xlGuess, _
                               OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
                                                                                           :=xlPinYin
    For n = 2 To i
        myC.Add Sh2.Cells(n, "F"), CStr(Sh2.Cells(n, "F"))
    Next
    n = 0
    For n = 1 To myC.Count
        Sh2.Range("F1:O" & i).AutoFilter Field:=1, Criteria1:=myC.Item(n)
        m = Sh2.[F65536].End(xlUp).Row
        [K3] = "  " & Sh2.Cells(m, "P")
        [F3] = "  " & Sh2.Cells(m, "G")
        [I3] = "  " & Sh2.Cells(m, "H")
        [C3] = "  " & Sh2.Cells(m, "I")
        [C4] = "  " & Sh2.Cells(m, "J")
        [I4] = "  " & Sh2.Cells(m, "Q")
        [F4] = "  " & Sh2.Cells(m, "R")
        [A6:M10] = ""
        Set myRng = Sh2.Range("F2:0" & m).SpecialCells(xlCellTypeVisible)
        myRng.Copy [A6]
        Sheet1.PrintOut
    Next
    Sh2.Range("S1:O" & i).AutoFilter
End Sub