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