Algumas coisas a mencionar:

(1) Uma pequena coisa: Você pode acessar a pasta de uma pasta de trabalho usando ThisWorkbook.Path(note que isso não contém a barra invertida final). Então use strCurrentPath = ThisWorkbook.Path

(2) Você atribui o nome da subpasta a uma variável chamada NewPathmas depois você acessa strNewPath. O mesmo problema com CurrentPathAndNamevs strCurrentPathAndName. Evite tais erros usando sempre Option Explicit.

Além disso, a menos que em seu código você planeje ter diferentes subpastas como pasta de backup, declare o novo caminho como constante, não como variável:

Const strNewPath = "OldForecasts"

(3) Conforme mencionado nos comentários, existem alguns comandos (bastante antigos) para manipulação de arquivos no VBA:

killpara apagar um arquivo
Dirpara verificar se um arquivo ou pasta existe. Para verificar pastas, você precisa adicionar vbDirectorycomo 2º argumento ao Dir-command.
MkDirpara criar uma pasta.

O código poderia ser parecido com este:

Option Explicit

Sub Createbackupfile()

    Const BackupFolder = "OldForecasts"

    Dim CurrentName As String
    Dim CurrentPathAndName As String
    Dim CurrentPath As String

    With ThisWorkbook
        CurrentName = .Name
        CurrentPathAndName = .FullName
        CurrentPath = .Name

        Dim newPath As String
        newPath = CurrentPath & "\" & BackupFolder
        If Dir(newPath, vbDirectory) = "" Then MkDir newPath
        .SaveAs Filename:=newPath & "\" & CurrentName, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        Kill CurrentPathAndName
    End With
End Sub

Observe que se esse código também for executado em um Mac, você precisará substituir a barra invertida por uma barra - ou usar Application.PathSeparator:

newPath = CurrentPath & Application.PathSeparator & BackupFolder

(até onde eu sei, os comandos em si funcionam em um Mac, mas não posso verificar isso porque não tenho um Mac para testar.)

(4) O FileSystemObjectScripting Runtime é uma forma alternativa de acessar informações de arquivos e pastas. Ele tem algumas vantagens sobre os comandos antigos (por exemplo, você pode percorrer recursivamente suas pastas e subpastas) e oferece comandos adicionais.

O Scripting Runtime está presente em todos os computadores Windows (mas não em nenhum Mac). Adicionar uma referência ao seu projeto apenas informa ao compilador VBA que você quer usá-lo (isso é chamado de early binding ). A vantagem é que o compilador pode verificar a sintaxe para você já no momento da compilação, e você tem o intellisense como suporte ao digitar o código.

No entanto, você pode viver perfeitamente sem vinculação antecipada usando CreateObject. Isso é chamado de vinculação tardia . O compilador não sabe nada sobre o objeto que é criado e, se você acessar qualquer propriedade ou método, o tempo de execução do VBA examinará o tempo de execução, se existir. Exemplo:

' Early binding (your current code)
With New FileSystemObject
    If .FileExists(CurrentPathAndName) Then
        .DeleteFile CurrentPathAndName
    End If
End With

O editor VBA pode ajudar você com o intellisense e o compilador verifica se os métodos FileExistse DeleteFileexistem. Se você tiver um erro de digitação (você digita por exemplo FileExist), o compilador já pode avisá-lo antes que o código seja executado.

' Late binding (no reference needed) 
With CreateObject("Scripting.FileSystemObject")
    If .FileExists(CurrentPathAndName) Then
        .DeleteFile CurrentPathAndName
    End If
End With

Agora o compilador não sabe nada sobre o objeto criado e você receberá um erro de tempo de execução ao usar um nome de método inválido.

Ambas as versões funcionarão em qualquer computador onde a biblioteca exista e não funcionarão em nenhum computador onde a biblioteca não exista. No entanto, quando a biblioteca não existe e você usa a vinculação antecipada, o código não será compilado e você não poderá usar nenhum código. Com a vinculação tardia, você pode usar qualquer outro código do seu projeto.

Mover a pasta de trabalho que contém o código para uma subpasta específica

Uma Chamada Simples

Sub MoveToOldForecasts()
    MoveFileToSubfolder ThisWorkbook, "OldForecasts"
End Sub

Uma ferramenta

Sub MoveFileToSubfolderRun()
    Dim SubfolderName  As String: SubfolderName = InputBox( _
        Prompt:="Please enter the name of the subfolder", _
        Title:="Move File to Subfolder", _
        Default:="Subfolder Name")
    MoveFileToSubfolder ThisWorkbook, SubfolderName
End Sub

O Método

Sub MoveFileToSubfolder(ByVal wb As Workbook, ByVal SubfolderName As String)
    Const PROC_TITLE As String = "Move File to Subfolder"
    On Error GoTo ClearError

    ' Check if no workbook was passed.
    If wb Is Nothing Then
        MsgBox "The workbook was not referenced!", vbExclamation, PROC_TITLE
        Exit Sub
    End If
     
    ' Check if the subfolder name was not supplied.
    If Len(SubfolderName) = 0 Then
        MsgBox "No subfolder supplied!", vbExclamation, PROC_TITLE
        Exit Sub
    End If
    
    ' Retrieve the source file name.
    Dim sFileName As String: sFileName = wb.Name

    ' Retrieve the source path.
    Dim sFolderPath As String: sFolderPath = wb.Path
    ' Check if the source file has no path.
    If Len(sFolderPath) = 0 Then
        MsgBox "The file """ & sFileName & """ was never saved!", _
            vbExclamation, PROC_TITLE
        Exit Sub
    End If
        
    ' Create/reference an instance of the 'Scripting FileSystemObject' object.
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' Build the destination file path.
    Dim dFolderPath As String:
    dFolderPath = fso.BuildPath(sFolderPath, SubfolderName)
    
    ' Create the destination folder.
    If Not fso.FolderExists(dFolderPath) Then
        On Error Resume Next
            fso.CreateFolder dFolderPath
        On Error GoTo ClearError
        ' Check if the destination folder was not created.
        If Not fso.FolderExists(dFolderPath) Then
            MsgBox "Could not create the folder """ & SubfolderName _
                & """ in """ & sFolderPath & """.", _
                vbExclamation, PROC_TITLE
            Exit Sub
        End If
    End If
    
    ' Build the destination file name and path.
    Dim dFileName As String: dFileName = fso.GetBaseName(sFileName) & ".xlsm"
    Dim dFilePath As String: dFilePath = fso.BuildPath(dFolderPath, dFileName)
    ' Note: Why not simply 'dFilePath = fso.BuildPath(dFilePath, sFileName)'?
    '       Because 'ThisWorkbook' could be e.g. a '.xls' or '.xlsb' file.
    '       It could even be e.g. a '.xlsx' file where the code
    '       was copied to.
        
    ' Retrieve the source file path.
    Dim sFilePath As String: sFilePath = wb.FullName
        
    ' Save the file to the destination folder.
    On Error Resume Next
        Application.DisplayAlerts = False
        ' The line above enables overwriting with no confirmation and prevents
        ' the appearance of the dialog when saving in a different file format.
            wb.SaveAs Filename:=dFilePath, _
                FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        Application.DisplayAlerts = True
    On Error GoTo ClearError
    ' Check if the file was not saved.
    If Not fso.FileExists(dFilePath) Then
        MsgBox "Could not save the file as """ & dFilePath & """!", _
            vbExclamation, PROC_TITLE
        Exit Sub
    End If
    ' Note: At this point the 'wb' variable points to the destination file.
    Debug.Print wb.Name, wb.Path ' the proof
    
    ' Delete the source file.
    On Error Resume Next
        fso.GetFile(sFilePath).Delete
    On Error GoTo ClearError
    ' Check if the source file was not deleted.
    Dim WasSourceDeleted As Boolean: WasSourceDeleted = True
    If fso.FileExists(sFilePath) Then WasSourceDeleted = False
    
    ' Inform.
    If WasSourceDeleted Then
        MsgBox "The file" & vbLf & vbLf & """" & sFilePath & """" & vbLf _
            & "was moved to" & vbLf & vbLf & """" & dFilePath & """.", _
            vbInformation, PROC_TITLE
    Else
        MsgBox "The file" & vbLf & vbLf & """" & sFilePath & """" & vbLf _
            & "was moved to" & vbLf & vbLf & """" & dFilePath & """." _
            & vbLf & vbLf & "Could not delete the source file """ & sFilePath _
            & """!", vbExclamation, PROC_TITLE
    End If
    
ProcExit:
    Exit Sub
ClearError:
    MsgBox "Run-time error [" & Err.Number & "]:" & vbLf & vbLf _
        & Err.Description, vbCritical, PROC_TITLE
    Resume ProcExit
End Sub