Sub ertert()
Dim f, sPath$
sPath = "E:\Downloads\YOYO1.xlsx"    'измените, как нужно
With Application
    .ScreenUpdating = False: .DisplayAlerts = False
End With
With Sheets("Отд-прайс")
    f = Application.Transpose(.Range("A1", .Cells(Rows.Count, 1).End(xlUp)))
End With
With Sheets("Лист1")
    .AutoFilterMode = False
    With .Range("A1:K" & .Cells(Rows.Count, 1).End(xlUp).Row)
        .AutoFilter 10, f, 7
        .Copy
        With Workbooks.Add
            .Sheets(1).Range("A1").Select: .Sheets(1).Paste
            .Sheets(1).Range("A1").CurrentRegion.Columns.AutoFit
            .SaveAs Filename:=sPath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            DoEvents:    '.Close
        End With
        .AutoFilter
    End With

End With
With Application
    .CutCopyMode = False: .ScreenUpdating = True: .DisplayAlerts = True
End With
End Sub