シートを同じ階層に保存

元データと同じ階層にブック内のシートを保存する。

Sub 同じ階層に保存()

　'マクロブックのパス
　Dim Path As String
　Path = ThisWorkbook.Path

　'シートを新規ブックへコピー
　Sheets(1).Copy

　'同じ階層に保存
　On Error Resume Next
　ActiveWorkbook.SaveAs Filename:=Path & "￥" & ActiveWorkbook.Sheets(1).Name & ".xlsx"

　'エラーがあった場合、メッセージ表示 既に保存されているとエラーになる
　If Err.Number <> 0 Then
　　MsgBox "保存しませんでした"
　End If

　'未保存の場合閉じる
　ActiveWorkbook.Close savechanges:=False

End Sub

 
On Error Resume Next

エラーが発生しても処理を止めない。通常だと以下のメッセージが表示されて止まる。

'エラーがあった場合、メッセージ表示
If Err.Number <> 0 Then

エラーが発生した場合は、Err.Numberに数字が格納される。
エラーが発生していない場合は0。