Poner Nombre de nuevo libro vba

Tengo el siguiente código que ayuda a exportar a un nuevo libro datos filtrados de una base de datos, el archivo se abre automáticamente. Lo que necesito que se guarde en una carpeta determinada con un nombre determinado.

Si alguien me pudiera ayudar. SLds

Dim Fila As Integar
Dim Fila2 As Integer
Dim Final As Integer
Dim Final2 As Integer
Dim Registro As Integer
Dim Registro2 As Integer
Dim objExcel As Object
Dim SaldoTotal As Integer
Dim NombreArchivo As String
Dim ContarFilas As Double
Dim ContarFilasFilas2 As Double
Dim CodProd As String
Dim FiladelTotal As Integer
Dim ValorSaldo As Double

Set objExcel = Workbooks.Add
objExcel.Activate
NombreArchivo = ActiveWorkbook.Name

For Fila = 1 To 10000
If Hoja10.Cells(Fila, 1) = "" Then
Final = Fila - 1
Exit For
End If
Next
CodProd = Me.TextBox1
ContarFilas = 3
Application.Workbooks(NombreArchivo).Worksheets(1).Cells(1, 1) = "DETALLE DE PEDIDOS DEL DIA" & " " & UCase(Me.TextBox1)

For Registro = 1 To Final
If Hoja10.Cells(Registro, 1) = CodProd Then
ContarFilas = ContarFilas + 1
Application.Workbooks(NombreArchivo).Worksheets(1).Cells(ContarFilas, 1) = "Minka" 'Local
Application.Workbooks(NombreArchivo).Worksheets(1).Cells(ContarFilas, 2) = Hoja10.Cells(Registro, 3) 'OT
Application.Workbooks(NombreArchivo).Worksheets(1).Cells(ContarFilas, 3) = Hoja10.Cells(Registro, 4) 'Ojo
Application.Workbooks(NombreArchivo).Worksheets(1).Cells(ContarFilas, 4) = Hoja10.Cells(Registro, 5) 'Tipo Lunas
Application.Workbooks(NombreArchivo).Worksheets(1).Cells(ContarFilas, 5) = Hoja10.Cells(Registro, 6) 'Medidas
Application.Workbooks(NombreArchivo).Worksheets(1).Cells(ContarFilas, 6) = Hoja10.Cells(Registro, 7) 'Dip ADD Altura
Application.Workbooks(NombreArchivo).Worksheets(1).Cells(ContarFilas, 7) = Hoja10.Cells(Registro, 8) 'Tipo Montura
Application.Workbooks(NombreArchivo).Worksheets(1).Cells(ContarFilas, 8) = Hoja10.Cells(Registro, 9) 'Parametros
Application.Workbooks(NombreArchivo).Worksheets(1).Cells(ContarFilas, 9) = Hoja10.Cells(Registro, 10) 'Observacion
Application.Workbooks(NombreArchivo).Worksheets(1).Cells(ContarFilas, 10) = Hoja10.Cells(Registro, 11) 'Registro
Application.Workbooks(NombreArchivo).Worksheets(1).Cells(ContarFilas, 11) = Hoja10.Cells(Registro, 12) 'Cotizado
Application.Workbooks(NombreArchivo).Worksheets(1).Cells(ContarFilas, 12) = Hoja10.Cells(Registro, 13) 'Adelanto
Application.Workbooks(NombreArchivo).Worksheets(1).Cells(ContarFilas, 13) = Hoja10.Cells(Registro, 14) 'montura
Application.Workbooks(NombreArchivo).Worksheets(1).Cells(ContarFilas, 14) = Hoja10.Cells(Registro, 15) 'Especialista
End If
Next
For FiladelTotal = 10 To 10000
If Application.Workbooks(NombreArchivo).Worksheets(1).Cells(FiladelTotal, 2) = "" And Application.Workbooks(NombreArchivo).Worksheets(1).Cells(FiladelTotal, 9) = "" Then
SaldoTotal = FiladelTotal
Exit For
End If
Next
Application.Workbooks(NombreArchivo).Worksheets(1).Cells(SaldoTotal, 1) = "FIN"
Unload Me
objExcel.Activate

Range(Cells(4, 1), Cells(SaldoTotal, 14)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.249946592608417
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.249946592608417
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.249946592608417
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.249946592608417
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.249946592608417
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.249946592608417
.Weight = xlThin
End With
Range("A3").Select
ActiveWindow.DisplayGridlines = False
Call Formatear_Reporte