VBAで同じシート名のコピー時は処理中止したいのですが・・・

質問

・先日VBAでシートのコピー時にシート名の変更の仕方をしえて頂き完成したのですが、ある問題が発生し困っています。以下が状況です。
シート１、シート２が有りシート１のコピーボタンを押すとシート1の例えば「A1」セル（2006-01)を参照しシート2の後に「2006-1」のシートを作成迄は教えて頂き出来ました。しかしシート1の「A1」セル（2006-01)を更新するのを忘れてコピーボタンを押すとエラーになってしまいます。同じシート名がある時は「重複です。」とかメッセージを出して中止したいのですが初心者で旨くいきません。nov-dさんの回答を元に色々調べましたが旨く動きません。ご教授宜しくお願いします。

回答No.2

hana-hana3 · ベストアンサー

処理前に重複シート名をチェックする方法です。

Private Sub CommandButton1_Click()

Dim Sheet_Name As String
Sheet_Name = Worksheets(1).Range("A1").Value

'シート名チェック
Dim ws As Variant
Dim flg As Boolean
For Each ws In ThisWorkbook.Worksheets
If Sheet_Name = ws.Name Then
flg = True
Exit For
End If
Next

If flg = False Then

Worksheets(1).Copy After:=Worksheets(2)

Sheets(2).Activate
Range("B36:B67").Select
Selection.ClearContents

Sheets(1).Activate
Range("I6:J6").Select
Selection.ClearContents
Range("C18:K48").Select
Selection.ClearContents
Range("Q18:AS48").Select
Selection.ClearContents
Range("D15").Select

'Unload UserForm2

ActiveSheet.Name = Sheet_Name

Else
MsgBox ("シート名が重複しています。別のシート名を指定してください。")

End If

End Sub

お礼

・hana-hana3有難うございました。
補足を記入後冷静に見てみると
ActiveSheet.Name = Sheet_Nameがsheet１がActivate
なってから実行なので当たり前でした。シートコピー後すぐActiveSheet.Name = Sheet_Name実行で見事解決いたしました。本当に有難うございました。

補足

・回答ありがとうございます。早速試してみて旨く動くのでシート名1を「稼動」、シート名2を「祝日」と変更し実行すると「稼動」シートのA1を参照し「稼動」シート名が「XXX」と変更され、「祝日」シートの後にコピーされたシート名は「稼動（２）」となってしまいます。以下がプログラムです。どこが違うか分かりません。ご教授宜しくお願いいたします。

Private Sub CommandButton1_Click()

Dim Sheet_Name As String
Sheet_Name = Worksheets("稼動").Range("A1").Value

'シート名チェック
Dim ws As Variant
Dim flg As Boolean
For Each ws In ThisWorkbook.Worksheets
If Sheet_Name = ws.Name Then
flg = True
Exit For
End If
Next

If flg = False Then

Worksheets("稼動").Copy After:=Worksheets("祝日")

Sheets("祝日").Activate
Range("B36:B67").Select
Selection.ClearContents

Sheets("稼動").Activate
Range("I6:J6").Select
Selection.ClearContents
Range("C18:K48").Select
Selection.ClearContents
Range("Q18:AS48").Select
Selection.ClearContents
Range("D15").Select
'Unload UserForm2

ActiveSheet.Name = Sheet_Name

Else
MsgBox ("シート名が重複しています。別のシート名を指定してください。")

'MsgBox " D:15のスピンボタンをクリックし、月度を変更して下さい。次にI:６とJ:６に月度の開始日と終了日を記入して下さい！！"

End If

End Sub

回答No.3

nov-d

nov-dです。プログラム、読ませていただきました。

自分の書いたプログラムのポイントは、「Worksheets(1).Copy After:=Worksheets(2)」の後すぐに「ActiveSheet.Name = Sheet_Name」としている点です。
（すぐと言っても、エラー判定のため「On Error GoTo ERR1」を間にはさんでいますが。）

WorkSheets(1).Copy・・・を実行すると、コピー後のシート（この時点では「Sheet1(1)」）がActiveになります。
そこで、Activeになっているシートを（「XXX」に）リネームするという仕組みです。

いただいたプログラムでは、その間に（「Sheets(1).Activate」などで）Activeなシートが変わってしまっているため、うまく動かないということだと思います。
試しに、「WorkSheets(1).Copy・・・」の行を、「On Error GoTo ERR1」の１行手前に移動してみてもらえませんか？
多分うまく動くと思うのですが。。。f^_^;
うまく動かなければ、またここで書いていただければと思います。

ＰＳ．
こちらではユーザーフォームを作らずに実行しているため、「Unload UserForm2」の行はコメントアウトして（行頭に「'」を付けて）実行しています。

お礼

・nov-dさんありがとうございました。おっしゃるとおり、「WorkSheets(1).Copy・・・」を動かして冷静に書き直して旨く動くようになりました。本当にありがとうございました。

補足

・回答ありがとうございました。Copy行を変更すると旨く動きましたが、何故か私のプログラムではシート名の重複がある時ちゃんとエラーは出るのですが「シート1（２）」が出来てしまいます。又、データを消してからコピーするのでこれでは本題から逸脱します。元のままだとシート１が「XXX」と名前変更され、シート2の後に「シート１（２）」が出来てしまいます。モーちょっと頑張って見ます。又ご教授お願いします。

回答No.1

nov-d

nov-dです。
あれ、上手くいきませんでしたか？
こっちでやると、（シートのコピー時ではなく）シート名のリネーム時にエラーハンドラが働いて、上手くerr1に飛びますが。。。
良ければプログラムを見せてもらえませんか？

Sub Copy_Sheet()
Dim Sheet_Name As String
Sheet_Name = Worksheets(1).Range("A1").Value
Worksheets(1).Copy After:=Worksheets(2)
On Error GoTo ERR1
ActiveSheet.Name = Sheet_Name
Exit Sub
ERR1:
MsgBox ("シート名が重複しています。別のシート名を指定してください。")
Exit Sub
End Sub

補足

・早速の回答ありがとうございます。実際の自分のプログラムの流れは以下の様にシート１，２の値を消すようにして有ります。流れを全て書くと

１）シート1の「A1」の値（XXX）を参照しシート２の後にシート1の名前を「XXX」にしてコピーする。
２）その際「XXX」が有れば処理を中止する。
３）「XXX」がなければシート１，２の値をクリヤーする
以上です。
因みに以下がプログラムです。

Private Sub CommandButton1_Click()
Dim Sheet_Name As String
Sheet_Name = Worksheets(1).Range("A1").Value
Worksheets(1).Copy After:=Worksheets(2)

Sheets(2).Activate
Range("B36:B67").Select
Selection.ClearContents

Sheets(1).Activate
Range("I6:J6").Select
Selection.ClearContents
Range("C18:K48").Select
Selection.ClearContents
Range("Q18:AS48").Select
Selection.ClearContents
Range("D15").Select

Unload UserForm2

On Error GoTo ERR1
ActiveSheet.Name = Sheet_Name
Exit Sub
ERR1:
MsgBox ("シート名が重複しています。別のシート名を指定してください。")

Exit Sub

End Sub

よろしくお願いします。