Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Path As String

    If Not Intersect(Target, Range("A2")) Is Nothing And Target.Count = 1 Then 'Change the range to fit your needs

        Application.ScreenUpdating = False
        Application.DisplayAlerts = False

            Path = Target.Value

            ThisWorkbook.SaveAs Filename:="D:R" & Path

        Application.ScreenUpdating = True
        Application.DisplayAlerts = True

        MsgBox "Completed"

    End If

End Sub