Como se puede ajustar la siguiente macro

Señores es posible ajustar esta macro para poder guardar el archivo con referencia a una celda

Public Sub copiahoja()
Sheets("ARMADOINTERFAZ").Copy
Application.ScreenUpdating = False
Dim dia As String
Dim tim As String
Dim nom As String
Dim ext As String
Dim Path As String
dia = Format(Date, "dd-mm-yyyy ")
tim = Format(Time(), " hh-mm-ss")
ext = ".TXT"
nom = nom + " " + dia + tim & ".TXT"
MsgBox "este es el nombre del archivo: INTERFAZ"" " & nom
Path = "d:\INTERFAZ" & nom
ActiveWorkbook.SaveAs Filename:=Path, FileFormat:=xlText, CreateBackup:=False
ActiveWorkbook.Close
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Sheets("INFORME").Range("H3").Value
.CC = " "
.BCC = ""
.Subject = "Interfaz" + " " + Range("i6") + " " + "del" + " " + Str(Date)
.Body = "Buenas Tardes:" + Chr(13) + Chr(13) + "Adjunto envío a usted, solicitud para vuestra gestión" + Chr(13) + Chr(13) + "Saludos" + Chr(13) + Chr(13) + Range("d29") + Chr(13) + "Sucursal" + " " + Range("i6")
.attachments.Add "D:\INTERFAZ" & nom
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Application.DisplayAlerts = False
End Sub