Sub ПДФ()
   Dim iNm, aNm
Application.ScreenUpdating = False
On Error Resume Next
With Worksheets("Протокол_неразр_28")
 aNm = .Range("BA6").Value
 iNm = .Range("BA5").Value
 MkDir "C:\Users\I_YES\Desktop\" & aNm & "\" & iNm
 .ExportAsFixedFormat Type:=xlTypePDF, _
     Filename:="C:\Users\I_YES\Desktop\" & aNm & "\" & iNm & "\" & iNm & ".pdf", _
     OpenAfterPublish:=False
End With
Application.ScreenUpdating = True
   
End Sub


Спасибо большое за помощь....

Я хочу сделать что бы у меня лист переводился в пдф, но перед этим создавал папку в указанном пути и с указанным названием в ячейке. Но итог таков что все получилось но почему он создает много лишних папок....  По этому подумал что надо как то привязаться к книге но не как не получается....

Здравствуйте, как сделать уточнее по книгам?

On Error Resume Next
   For Each oCell In Range([BA5], [A65536].End(xlUp))
   If Not IsEmpty(oCell) Then MkDir "C:\Users\I_YES\Desktop\" & oCell
Next

Спасибо большое все сработало,,,,,,,,,,,,, Низкий вам поклон...

Здравствуйте, у меня похожая ситуация но проблема в том что но не хочет воспринимать текс с ячейки и выдает ошибку....



Sub ПДФ()

Dim a
 a = Sheets("Протокол_неразр_28").[BA5].Value
   Application.ScreenUpdating = False
   ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
           Filename:="C:\Users\I_YES\Desktop\" & a & ".pdf", _
           OpenAfterPublish:=False
   Application.ScreenUpdating = True
   
End Sub