Sub フォルダとファイルの新規作成()
    
    FN = ActiveWorkbook.Name
    AP = ActiveWorkbook.Path
    
    MkDir "E:\営業所2"
    ActiveWorkbook.SaveAs Filename:="E:\営業所2\第一営業部.xlsm"
    
    Workbooks.Open Filename:=AP & "\" & FN
    
    Windows("第一営業部.xlsm").Activate
    ActiveWorkbook.Saved = True
    ActiveWorkbook.Close
End Sub