マクロ実行中にシートのアクセスできなくなるエラーを解消したい。 下記コードは"当直台帳"というファイ

マクロ実行中にシートのアクセスできなくなるエラーを解消したい。
下記コードは"当直台帳"というファイル上で走らせます。
"当直台帳"を開くと、ユーザーフォームが立ち上がるため、そこから起動するものです。
一度別のファイルに保存してから、再度"当直台帳"に保存しようとすると、上手くいきません。
解決可能でしょうか。御願いします。

Private Sub 当直を始める_Click()Dim d As String
Dim t As String
Dim i As Long
Application.DisplayAlerts = False Unload UserForm1
Application.EnableCancelKey = xlDisabled
ActiveWorkbook.Unprotect Password:="1930"
d = Worksheets("list").Range("A1").Value
t = Format(Date, "yyyymm")
If d <> t Then
ActiveSheet.SaveAs Filename:=ThisWorkbook.Path & "\当直台帳" & d
ActiveSheet.SaveAs Filename:=ThisWorkbook.Path & "\当直台帳" 'ここで止まる

Worksheets("list").Range("A1").Value = t

For i = 5 To Sheets.Count
If i = 5 Then
Sheets(i).Select
Else
Sheets(i).Select (False)
End If
Next i

ActiveWindow.SelectedSheets.Delete

End If
Sheets("当直mother").Select
Sheets("当直mother").Copy After:=Sheets(Worksheets.Count)
Sheets("当直mother (2)").Select
Sheets("当直mother (2)").Name = Format(Now, "当直d日")
ActiveSheet.Unprotect Password:="1930"
Range("H6:M6").Select
ActiveCell.FormulaR1C1 = Format(Now, "m月d日")
Range("P6:U6").Select
ActiveCell.FormulaR1C1 = Format(Now, "m月d日")

Range("F7:U100").Select
Selection.Locked = False
Selection.FormulaHidden = False
ActiveSheet.Protect Password:="1930"

ActiveWorkbook.Protect "1930", Structure:=True
Application.DisplayAlerts = False
End Sub

No.2 ベストアンサー 回答者： GooUserラック 回答日時： 2017/07/21 03:06

No.1 の訂正

大変申し訳ございません。ここではなくもっと前でエラーですね。

「ActiveSheet.SaveAs Filename:=ThisWorkbook.Path & "\当直台帳" & d」
「ActiveSheet.SaveAs Filename:=ThisWorkbook.Path & "\当直台帳" 'ここで止まる」
の２行を
「ActiveSheet.Copy」
「ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\当直台帳" & d」
「ActiveWindow.Close」
「ActiveWorkbook.Save」
にしたらどうでしょうか？
最後の「ActiveWorkbook.Save」は不要かもしれませんが…

この回答へのお礼

ありがとうございます。
回答いただいたままだとうまくいかなかったのですが、copyを作るということで、該当部分を書き換えてうまくいかました。
止まる1行前を

Thisworkbook.savecopyas と書いていけば、止まるとこの式自体不要になりました。

お陰様でエラーから抜けられました。
ありがとうございます。

お礼日時：2017/07/21 05:50

No.1 回答者： GooUserラック 回答日時： 2017/07/21 02:51

「Sheets("当直mother (2)").Select」

「Sheets("当直mother (2)").Name = Format(Now, "当直d日")」
この２行を
「Sheets(Worksheets.Count).Name = Format(Now, "当直d日")」
にされたらどうなりますか？
これで改善されるのならば、コピーしたときにシート名のカッコ内の数が「2」以外になっている可能性が高いです。（内部でうまく更新されない状態で続けてコピーすると次の数が使われるので…）
実際には最後のシートの後にコピーして追加するので、新しく追加されたシートが最後のシートになるのでこういう書き方の方が間違いありません。
今回は多分必要ありませんがセレクトしたい場合は
「Sheets(Worksheets.Count).Select」
「ActiveSheet.Name = Format(Now, "当直d日")」
にされると良いと思います。