VBAでシートコピー後、シート名が重複している時の処理

Question

今日からＶＢＡを勉強し始めました初心者です。会社である作業をしており、ＶＢＡでの作業がうまくいかなくて困っております。

「実績」というシートを11/5に作ったとします。
このシートを、11/9にマクロを実行した時に、
　　・11/5のシートをコピーし複製を作る（この時点ではシート名は「実績(２)」）
　　・この時、シート名は「11-05」となるように設定済み
　　　（実績シートの「Ｇ１」セルから、日付を取得しファイル名とする）　としています。

この時、まれに同じ日に間違ってマクロを動かす為、同じシート名となりエラーが出てしまいます。
利用者が不慣れなため、エラーの対処方法を教えることでは対処が難しい状態で、できればマクロで対応しようと思っています。

以下、シート名が重複しない場合のみ利用可能なデータです。

'前回作成した「実績」のコピー＆リネーム

    Dim mySheet As Worksheet
    Set mySheet = ActiveWorkbook.Worksheets("実績")
    mySheet.Copy after:=Worksheets("実績")
     　　'実績sheetの後ろにコピー
    ActiveSheet.Name = Format(Range("G1").Value, "m-dd")
         ' シート名を変更する

他の質問を検索しましたが、コピーしたファイルをリネームし、
そのリネーム結果が重複している場合の記述方法がよくかわりませんでした。

重複している場合は、できればメッセージボックスで「yesno」の選択で上書きの選択ができればと思っています。
（ＶＢＡでは一度削除してから新規に作るようですが、上の重複のからみで、よくわからなくなっています）

よろしくお願いします。

Wendy02 · Accepted Answer

こんばんは。

>ActiveSheet.Name = Format(Range("G1").Value, "m-dd")

意味は分かるのですが、こういうコードは、確かにこれで通るのですが、かなり乱暴なやり方です。Range("G1").Value ではなくて、「実績」の方のG1 の値のはずです。

なお、当たり前ですが、「標準モジュール」に登録してください。

Sub Test1()
　　Dim mDate As String
　　Dim Ret As Variant
　　With Worksheets("実績")
　　　　mDate = Format(.Range("G1").Value, "m-dd")
　　　　Ret = Evaluate("='" & mDate & "'!A1")
　　　　If Not IsError(Ret) Then
　　　　　　If MsgBox("既に、" & mDate & " シートはあります。" & vbCrLf & _
　　　　　　　　"上書きしますか？", vbQuestion + vbOKCancel) = vbCancel Then
　　　　　　　　Exit Sub
　　　　　　Else
　　　　　　　　.Cells.Copy Worksheets(mDate).Range("A1")
　　　　　　End If
　　　　Else
　　　　　　.Copy After:=Worksheets("実績")
　　　　　　ActiveSheet.Name = mDate
　　　　End If
　　End With
End Sub

Wendy02 · Answer

こんばんは。

>>ActiveSheet.Name = Format(Range("G1").Value, "m-dd")

ActiveSheet.Name
　と
Format(Range("G1").Value, "m-dd")

Range("G1").Value　の親オブジェクトは、ActiveSheet ですが、もともと、そのシート名を起こすための「日付」は、元になったシートのはずです。コピーしているから同じことですが。VBAでは、省略したときに、その親オブジェクトがどうなっているのか、常に頭に入れておかなくてはなりません。一見は、正しいように見えても、それを曖昧にしていると、エラーや、まったく違った値になることがあります。

With Worksheets("実績")
mDate = Format(.Range("G1").Value, "m-dd")

Range の前に、「.（点）」が入っているのは、その為です。この辺りは、VBAを1年ぐらい経ってから、良く失敗する部分です。

zap35 · Answer

一例です。最初のMacro1は存在するシートの名前を調べて、同名のシートがあれば確認メッセージを出すものです。Macro2ははじめにシート名の変更を行ってみて、エラーが発生したら（＝同名のシートがあり）警告メッセージを出すものです。どちらかというとMacro1の方がBetterでしょう。

なお同名のシートがあって、上書きをしない場合は「11-9-2345」のように時刻をシート名に入れるようにしています

Sub Macro1()
Dim mySheet, sh As Worksheet
Dim res As Integer
Dim str As String
Dim psw As Boolean
　Set mySheet = ActiveWorkbook.Worksheets("実績")
　mySheet.Copy after:=Worksheets("実績")
　　'実績sheetの後ろにコピー
　str = Format(Range("G1").Value, "m-dd")
　For Each sh In Worksheets
　　If sh.Name = str Then
　　　psw = True
　　End If
　Next sh
　If psw Then
　　res = MsgBox("同名のシートが既に存在しますが上書きしますか？", vbOKCancel)
　　If res = 1 Then
　　　Application.DisplayAlerts = False
　　　Worksheets(str).Delete
　　　ActiveSheet.Name = str
　　　Application.DisplayAlerts = True
　　Else
　　　ActiveSheet.Name = str & Format(Time, "-hhmm")
　　End If
　Else
　　ActiveSheet.Name = str
　End If
End Sub


Sub Macro2()
Dim mySheet As Worksheet
Dim res As Integer
Dim str As String
　Set mySheet = ActiveWorkbook.Worksheets("実績")
　mySheet.Copy after:=Worksheets("実績")
　　'実績sheetの後ろにコピー
　On Error GoTo err1
　str = Format(Range("G1").Value, "m-dd")
　ActiveSheet.Name = str
　Exit Sub
err1:
 res = MsgBox("シート名が重複しますが上書きしますか？", vbOKCancel)
　If res = 1 Then
　　Application.DisplayAlerts = False
　　Worksheets(str).Delete
　　ActiveSheet.Name = str
　　Application.DisplayAlerts = True
　Else
　　ActiveSheet.Name = str & Format(Time, "-hhmm")
　End If
End Sub

n-jun · Answer

コピーする前に、変更予定のシート名が存在するかどうか確認すると言う事ではなくて？
そう言った過去ログ等なら見つかるかも。。。

VBAでシートコピー後、シート名が重複している時の処理

こんばんは。

こんばんは。

一例です。

コピーする前に、変更予定のシート名が存在するかどうか確認すると言う事ではなくて？

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

今、見られている記事はコレ!

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング