Sub Крест1_Щелчок()
Dim fso As Object, el As Range
' Выбор ячейки с названием папки
Set el = Application.InputBox( _
Prompt:="Выберите строку с названием папки", _
Title:="Строка с названием", _
Default:=Intersect([G:G], Selection.EntireRow).Address, _
Type:=8)

' Папка для создания по умолчанию
sFldr = "Z:\Бухгалтерия\2021 - 1 квартал\"
' Возмоожность изменить папку
sFldr = InputBox( _
Prompt:="Адрес сохранения", _
Title:="Куда сохранять?", _
Default:=sFldr)
If Not el Is Nothing And sFldr <> "" And el.Value <> "" Then
Set el = Intersect([G:G], el)
If Dir(sFldr, vbDirectory) = "" Then MkDir sFldr ' создаем, если нет
Set fso = CreateObject("Scripting.FilesystemObject")
If Not fso.FolderExists(sFldr & el.Value) Then
fso.CreateFolder (sFldr & el.Value)
End If
Else
MsgBox "Папка или название файла не выбраны.", vbCritical
End If
End Sub