Sub 同じ階層に保存()
Dim openBook As Workbook
Dim openPath As String'選択したブック名を格納
openPath = Application.GetOpenFilename("xls,*.xls?")
If openPath <> "False" Then'格納したブックを開く
Set openBook = Workbooks.Open(openPath)'マクロブックと同じ階層に保存
openBook.SaveAs (ThisWorkbook.Path & ActiveWorkbook.Name)openBook.Close savechanges:=True
MsgBox "完了しました"Else
MsgBox "中止します"
End If
End Sub