ChDirステートメントでカレントフォルダを簡単に変更する

Option Explicit

Sub ChDirテスト1()
    Dim vala, valb, valc
    Dim aPath, bPath As String
    Dim aPCo As Long
        Workbooks("VBAChDir説明.xlsm").Activate
        Worksheets("Sheet1").Select
        vala = Range("A1").Value
        valb = Range("A3").Value
        valc = Range("A5").Value
'このBOOKの絶対パスを代入
        aPath = ThisWorkbook.Path
'この絶対パスで一つ上のフォルダパスまでの表示文字数
        aPCo = InStrRev(aPath, "\")
'データの移送先フォルダの絶対パスを代入
        bPath = Left(aPath, aPCo) & "ファイル移動先\"
'新しいWorkbookを作成します
        Workbooks.Add
'作成したWorkbookを名前を付けて、移動先フォルダに保存します
        ActiveWorkbook.SaveAs Filename:=bPath & vala & ".xlsx"
'このWorkbookを上書き保存します
        ActiveWorkbook.Close savechanges:=True
        Workbooks.Open Filename:=vala & ".xlsx"
        Worksheets("Sheet1").Name = valb
        Range("C5").Value = valc
End Sub

Sub ChDirテスト2()
    Dim vala, valb, valc
    Dim aPath As String, bPath As String
    Dim aPCo As Long
        Workbooks("VBAChDir説明.xlsm").Activate
        Worksheets("Sheet1").Select
        vala = Range("A1").Value
        valb = Range("A3").Value
        valc = Range("A5").Value
'このBOOKの絶対パスを代入
        aPath = ThisWorkbook.Path
'この絶対パスで一つ上のホルダパスまでの表示文字数
        aPCo = InStrRev(aPath, "\")
'データの移送先フォルダの絶対パスを代入
        bPath = Left(aPath, aPCo) & "ファイル移動先\"
'新しいWorkbookを作成します
        Workbooks.Add
'作成したWorkbookを名前を付けて、移動先フォルダに保存します
        ActiveWorkbook.SaveAs Filename:=bPath & vala & ".xlsx"
'このWorkbookを上書き保存します
        ActiveWorkbook.Close savechanges:=True
'カレントディレクトリを移動します
        ChDir bPath
        Workbooks.Open Filename:=vala & ".xlsx"
        Worksheets("Sheet1").Name = valb
        Range("C5").Value = valc
End Sub