Like so:

Sub Sort()
    Application.Goto Reference:="R6C3:R2000C27"
    ActiveWorkbook.Worksheets("Access").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Access").Sort.SortFields.Add Key:=Range("C6"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Access").Sort
        .SetRange Range("C6:aa2000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Dim vFIND As Range, vFIRST As Range
    With ActiveWorkbook.Worksheets("Access")
        On Error Resume Next
        Set vFIND = .Range("F:F").Find("Company", LookIn:=xlValues, LookAt:=xlWhole)
        If Not vFIND Is Nothing Then
            Set vFIRST = vFIND
            Do
                .Range("Q" & vFIND.Row).Resize(, 11).Value = "-"
                Set vFIND = .Range("F:F").FindNext(vFIND)
            Loop Until vFIRST.Address = vFIND.Address
        End If
    End With

    Sheets("Search").Range("B4:C4").ClearContents
    ActiveWorkbook.Save

End Sub