vbaについて勉強中です

質問

以下の構文を実行しました。
結果、Ｂファイルにはｓｈｅｅｔ（仮）が挿入されましたがＡファイルのｓｈｅｅｔ１がコピーされません。
どこがどのように間違っているのかわかりません。
どなたかご教授ください。

Sub コピー()

Dim sc '貼り付け先ファイルのシート数
Dim scn '貼り付け先ファイルのシート名
Dim F_T '貼り付け先ファイル名
Dim F_0 'コヒー元ファイル名
Dim cc 'コピー元のシート数
Dim ccn 'コピー元のシート名

On Error GoTo ed 'エラーの場合の処理
F_T = Application _
.GetOpenFilename("エクセルファイル(C:\Users\***\Desktop\B\B.xlsx),C:\Users\***\Desktop\B\B.xlsx", _
, "貼り付け先ファイルを開く")
If F_T = False Then GoTo ed
Workbooks.Open F_T
F_T = ActiveWorkbook.Name
sc = Workbooks(F_T).Sheets.Count
'作業用の仮シートの追加
ActiveWorkbook.Sheets.Add After:=Worksheets(sc)
ActiveSheet.Name = "仮"
F_0 = Application _
.GetOpenFilename("エクセルファイル(C:\Users\***\Desktop\A\A.xlsm),C:\Users\***\Desktop\A\A.xlsm", _
, "コピー元ファイルを開く")
If F_0 = False Then GoTo ed
Workbooks.Open F_0
F_0 = ActiveWorkbook.Name
cc = Workbooks(F_0).Sheets.Count
'このブックのシート名のすべてを繰り返し
For f = sc To 1 Step -1
scn = Workbooks(F_T).Sheets(f).Name
'コピー元のブックのシート名を繰り返し
For T = 1 To cc
ccn = Workbooks(F_0).Sheets(T).Name
'もし、シート名が同じなら
If scn = ccn And Workbooks(F_T).Sheets.Count > 1 Then
'シートの削除
Application.DisplayAlerts = False
Workbooks(F_T).Worksheets(ccn).Delete
Application.DisplayAlerts = True
Else
End If

Next T
Next f
'コピー元のブックのシート名を繰り返し
For T = cc To 1 Step -1
ccn = Workbooks(F_0).Sheets(T).Name
'シートのコピー
Workbooks(F_0).Worksheets(ccn).Copy _
Before:=Workbooks(F_T).Worksheets(1)
Next T
'作業用の仮シートの削除
Application.DisplayAlerts = False
Workbooks(F_T).Worksheets("仮").Delete
Application.DisplayAlerts = True

Workbooks(F_0).Close SaveChanges:=False

Exit Sub

ed: MsgBox "エラーが発生したため、処理を取り消しました"

End Sub

回答No.1

x-1919 · ベストアンサー

長々とコードを張り付けて、その目的、正常稼働のイメージも告げずに "すぐに回答を!" ってのはどうなんだろか。

以下、勝手に想像した仕様に基づいた検証。
仕様：
A.xslm ファイルの全シートを B.xlsx にコピーする。
もし A.xlsm ファイルのシートと同じ名前のシートが B.xlsx に存在したら、先に B.xlsx 側の同名シートを削除してからコピーする。

サンプル:
以下の 2つのブックを使って検証を行った。
A.xlsm
　"Sheet1" "シート1" "シート2" "シート3" "ほげ" の 4つのシートを持ち、各シートのセルにはブック名とシート名を記述。
B.xlsx
　"シートA" "シートB" "シートC" "ほげ" の 4つのシートを持ち、各シートのセルにはブック名とシート名を記述。

検証結果:
コードを実行した結果、B.xlsx には A.xlsm からコピーされた "Sheet1" "シート1" "シート2" "シート3" "ほげ" と、最初からあった "シートA" "シートB" シートC" が残り、最初から B.xlsx にあった "ほげ" は削除された。
したがって、「結果、Ｂファイルにはｓｈｅｅｔ（仮）が挿入されましたがＡファイルのｓｈｅｅｔ１がコピーされません。」 は再現しなかった。ただし "Sheet (仮)" が何の事なのかは不明。

その他に気になった点：
提示されたコードでは B.xlsx に空のシートを追加して "仮" という名前にする箇所があるが、このシートに対して特に何の処理もせず、あとから削除しているのが不要だと感じた。

For ~ Next のカウントに使っている変数 f と T の宣言がされていない。

変数の使いまわしが多い。

別のブックをコントロールする内容なのにオブジェクト変数 (Workbook型や Worksheet型) を使用せずにブック名やシート名の文字列頼りになっている点で、処理対象を誤る危険性を感じる。
下のコードは洗練されてないが、とりあえず作ってみたもの。
コピー後のシートの並び順が希望と逆になっているが、とりあえず動くと思う。
Sub hoge()
　　Dim destBook As Workbook ' コピー先ブック
　　Dim destSheet As Worksheet ' コピー先ブックのシート
　　Dim srcBook As Workbook ' コピー元ブック
　　Dim srcSheet As Worksheet ' コピー元ブックのシート
　　Dim destPath As Variant, srcPath As Variant ' ブックのパス
　　destPath = Application.GetOpenFilename("Excel ファイル (*.xlsx), *.xls", , "貼り付け先ファイル")
　　If destPath = False Then
　　　　Exit Sub
　　End If

　　srcPath = Application.GetOpenFilename("Excel ファイル (*.xlsm), *.xls", , "コピー元ファイル")
　　If srcPath = False Then
　　　　Exit Sub
　　End If

　　Set destBook = Workbooks.Open(destPath)
　　Set srcBook = Workbooks.Open(srcPath)

　　For Each srcSheet In srcBook.Worksheets
　　　　For Each destSheet In destBook.Worksheets
　　　　　　If srcSheet.Name = destSheet.Name Then
　　　　　　　　Application.DisplayAlerts = False
　　　　　　　　destSheet.Delete
　　　　　　　　Application.DisplayAlerts = True
　　　　　　　　Exit For
　　　　　　End If
　　　　Next
　　　　srcSheet.Copy Before:=destBook.Worksheets(1)
　　Next

　　srcBook.Close SaveChanges:=False
End Sub

お礼

回答ありがとうございます。
質問の仕方が悪くすみません。
早々、実行してみます。