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

質問

今日からＶＢＡを勉強し始めました初心者です。会社である作業をしており、ＶＢＡでの作業がうまくいかなくて困っております。

「実績」というシートを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」の選択で上書きの選択ができればと思っています。
（ＶＢＡでは一度削除してから新規に作るようですが、上の重複のからみで、よくわからなくなっています）

よろしくお願いします。

回答No.3

Wendy02 · ベストアンサー

こんばんは。

>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

お礼

早いアドバイスありがとうございました。
無事、完成させることができました。
ありがとうございました。

一点、
>ActiveSheet.Name = Format(Range("G1").Value, "m-dd")

>意味は分かるのですが、こういうコードは、確かにこれで通るのですが、かなり乱暴なやり方です。Range("G1").Value ではなくて、「実績」の方のG1 の値のはずです。

というのが、乱暴な理由がよくわかりませんでした。
なにか決まり事や、常識のようなものがあるのでしょうか？
すいません。

回答No.4

Wendy02

こんばんは。

>>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年ぐらい経ってから、良く失敗する部分です。

お礼

なるほど、大変よくわかりました。
今はまだかなりの初心者なので、こういうところは
曖昧にせず記述しておいたほうが頭がすっきりしそうですね。
ありがとうございました。

回答No.2

zap35

一例です。最初の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

お礼

早いアドバイスありがとうございました。
無事、完成させることができました。
ありがとうございました。

回答No.1

n-jun

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

お礼

元々あるファイルをコピーしてから、ファイル名を変更するという手順です。
他にもマクロを組んでいるところへ差し込む予定なので、コピーする前に確認する手順に変更するのはややこしいかなと思いました。
上の方に頂いた回答で解決しました。
ありがとうございました。