Сохранение готового файла на диск D

[Татьяна123456789]

Есть макрос, но готовй файл сохраняет в новую созданую папку и в корень папки где находиться этот Макрос. Как внести изменения, чтобы готовый файл сохраняло на диск D

Sub ОбработатьВсеФайлы()
НоваяПапка = NewFolderName & Application.PathSeparator
Application.ScreenUpdating = False

Call Number1

Call number2

Call Sxema

Call number3

Sheets("Схема").Copy
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range("r1").Formula = _
"=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(g1,""/"",),""\"",),""*"",),"""""""",),""("",),"")"",),""'"",)"

Range("r1").Copy
Range("r1").PasteSpecial Paste:=xlPasteValues
'Trim$(.Cells(3
mystring = Range("r1").Value
ФирмаПОКУПАТЕЛЬ = Trim(mystring)
edrpou = Range("f1").Value
iFilename = НоваяПапка & edrpou


StartDate = Workbooks("scheme_1036_ЕслиОднаФирмаПлюсРиск").Sheets("start").Cells(4, 3).Value
EndDate = Workbooks("scheme_1036_ЕслиОднаФирмаПлюсРиск").Sheets("start").Cells(5, 3).Value

ActiveWorkbook.SaveAs Filename:=iFilename & " " & ФирмаПОКУПАТЕЛЬ & " " & StartDate & EndDate & ".xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False

Rows("1:1").Select
Selection.RowHeight = 30
With Selection
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
Range("A1").Select


ActiveWorkbook.Close SaveChanges:=True

'очищаем на листе схема ячейки от содержимого и границы таблицы
With Sheets("схема").Cells
.Interior.Pattern = xlNone
.Interior.TintAndShade = 0
.Interior.PatternTintAndShade = 0
End With

Sheets("pz_in").Cells.Clear

Sheets("pk_in").Cells.Clear

MsgBox "Готовая схема находится в: " & НоваяПапка
End Sub
Function NewFolderName() As String
'Название для новой папки
NewFolderName = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, "ГотоваяСХЕМА " & Get_Now)
'Создаем новую папку по названию
MkDir NewFolderName
End Function
Function Get_Date() As String: Get_Date = Replace(Replace(DateValue(Now), "/", "-"), ".", "-"): End Function
Function Get_Time() As String: Get_Time = Replace(TimeValue(Now), ":", "-"): End Function
Function Get_Now() As String: Get_Now = Get_Date & " в " & Get_Time: End Function

 

[regnor]

вы чет перепутали язык...