Tenho alguns modelo de macro que pode ti ajudar, faça algumas adaptações como & Plan1 Ranger e o formato, tem muita gente boa aqui para ti ajudar.

Sub SALVARR()
    If MsgBox(" DESEJA SALVAR UMA CÓPIA DA PLANILHA ?   ", vbInformation + vbYesNo) = vbYes Then
    Set objWS = CreateObject("WScript.Shell")
    ActiveWorkbook.SaveCopyAs Filename:= _
    objWS.SpecialFolders("mydocuments") & "Arquivo " & Plan1.Range("B1") & Format(Date, "  dd-mm-yyyy") & ".xlsm"
End If
End Sub
Sub SalvarCópia_AreaTrabalho() 'Salvar Copia da planilha Sem Macros Excel 2010 ou 2007
If MsgBox("Deseja Criado uma Cópia da Planilha Original na Área de Trabalho ? ", vbQuestion + vbYesNo) = vbYes Then
Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set objWS = CreateObject("WScript.Shell")
    ActiveWorkbook.SaveAs Filename:= _
    objWS.SpecialFolders("Desktop") & "Cópia.xlsx", _
    FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.Save
    ActiveWorkbook.Close savechanges:=False
     Else
  If resposta = False Then
ActiveWorkbook.Close savechanges:=False
    End If
    End If
End Sub
Sub SalvarPlanilhaExcel_2007() 'programação p/ salvar cópia da planilha com macros no excel 2007
Set objWS = CreateObject("WScript.Shell")
    ActiveWorkbook.SaveAs Filename:= _
    objWS.SpecialFolders("Desktop") & "Cópia.xls", _
        FileFormat:=xlExcel8, Password:="VelvetSweatshop", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWindow.SmallScroll Down:=3
End Sub
Sub salvar()
Application.DisplayAlerts = False
'ActiveWorkbook.SaveAs
ChDir "C:UsersUsuárioDocumentsAperfeiçoamento Reg. Diario VTR'S"
Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:= _
        "C:UsersUsuárioDocumentscopia .xlsm" _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
       'Application.DisplayFullScreen = True
'Application.WindowState = xlMaximized
MsgBox ("ATENÇÃO - SALVANDO UMA CÓPIA DA ORIGINAL, ACONSELHO QUE SALVE UMA CÓPIA NO FINAL DE CADA SERVIÇO, OU ANTES DE MANIPULAR ESTA PLANILHA, À CÓPIA SO SERÁ USADA EM UMA EVENTUAL DESPROGRAMAÇÃO DA ÓRIGINAL. ESTA PLANILHA SERÁ FECHADA E SALVA EM OUTRA PASTA ELA VAI FICAR COMO ARQUIVO, E VOCÊ DEVE REABRIR A DA ÁREA DE TRABALHO OK!"), 60, _
("ATENÇÃO")
ActiveWorkbook.SaveAs
Application.Quit
       End
End Sub
'Macro para salvar planilha na área de trabalho
   Sub salvar2()
       Dim arq
       arq = ActiveSheet.Name & ".xlsm"

       On Error GoTo fim1
       ChDir "C:UsersivairDesktop"       'Windows 7
       ActiveWorkbook.SaveAs Filename:="C:UsersNome do UsuarioDesktoppppp.xlsm"

fim1:
       On Error GoTo fim2
       ChDir "C:Documents and SettingsNome do UsuarioDesktop"     'Windows XP
       ActiveWorkbook.SaveAs Filename:=arq

fim2:
End Sub
Sub SalvarCópia_AreaTrabalho3()
    Set objWS = CreateObject("WScript.Shell")
    ActiveWorkbook.SaveCopyAs Filename:= _
    objWS.SpecialFolders("Desktop") & "Arquivo Provisório.xlsm" _
    '
End Sub

Miguel muito obrigado mesmo....
consegui achar esta macro parece que deu certo....mais muito obrigado por responder vou tentar usar a sua....

Sub AleVBA_3132V2()
Dim FName As String
Dim FPath As String
Dim FExtention As String

FName = ActiveWorkbook.Sheets("Plan1").Range("B1")
FPath = ActiveWorkbook.Sheets("Plan1").Range("B2")
FExtention = ActiveWorkbook.Sheets("Plan1").Range("B3")
ActiveWorkbook.SaveAs fileName:=FPath & "" & FName & FExtention

End Sub