PCメモ

Excelを中心とした業務改善の記録

シートを同じ階層に保存

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

 

f:id:abv72:20210227222434p:plain

 

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

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

f:id:abv72:20210318221957p:plain

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

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