Sub Открытие_файлов_в_папке() With Application.FileDialog(msoFileDialogFolderPicker) .Title = "Выберите папку" If .Show = False Then Exit Sub sFolder = .SelectedItems(1) End With sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator) sfiles = Dir(sFolder & "*.xls*") Do While sfiles <> "" Set importWb = Workbooks.Open(sFolder & sfiles) Sheets.Select ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ ThisWorkbook.Path & "\" & ActiveWorkbook.Name _ , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _ :=False, OpenAfterPublish:=True importWb.Close False sfiles = Dir Loop End Sub