質問: False wB.Save wB.Close '----元のファイルを保存し閉じる MsgBox "転記しました。" Workbooks.Open Filename:=myPath & fN, ReadOnly:=True '----読み取り専用で開く End Sub ### 試したこと ### 補足情報 使用バージョン:Excel2010
回答: > > 1Bの集約管理ファイルを閉じていると開くのですが、開いていたらメッセージボックスは表示されず「ファイルが見つかりません。ファイル名保存場所が正しいか・・」と出ます。 > > > とりあえず既に開いている場合に閉じる処理が無いのが問題ですね。 > > 2ActiveSheet.PasteSpecialから進めなくなりました。 > > > このエラーの原因は本来Range.PasteSpecialにしか存在しないパラメータ「Paste:=」をWorksheet.PasteSpecialに対して使用しているためですね。 どちらも同じ名称のメソッドですから、編集の過程で変えてしまったのでしょう。 本件はコピー&ペーストが必要ない事例ですが、そこが質問のキモなのでそのまま残しています。 しかし、色々とバグの原因が混ざっているので順番に指摘していきます。 1.DisplayAlertsの位置が良くない。 この手のスイッチは必要最小限な範囲に使うように心がけたほうが良いです。 例えば今回の場合はOpen時の様々な警告を無視するためだと思いますのでOpenだけに適用しています。 2.Withの使い方がおかしい。 WithステートメントはWorkbook、Worksheet、Rangeなどの変数の代替するためのものです。 利用するにはドットから初めなければなりませんが、提示されたコードではドットが付いていません。 3.極力ActiveSheetや省略Cellsは使わないように。 Withが上手く使えていないのが原因で、「Cells(x, 2).Value = "*"」などはActiveSheetが省略されたものとして動作します。 ※プログラムを標準モジュールに書いた場合 従って、前に記載されている「Sheets("list").Activate」の影響でlistに対して処理することになり、意図したように動作しないはずです。 基本的にシートオブジェクトは指定するようにしてください。 たとえば、せっかく「Set wS = wB.Worksheets("list")」としているのに、すぐ下でActiveSheet.PasteSpecialとしていますよね。 同じオブジェクトを指すのですからwSを使いましょう。 今回の場合、Open直後に「Sheets("list").Activate」を実行しているので、この時点で変数に代入しておけばOKです。 4.インデントに手を抜かないこと。 コードが読みづらくなるということは、ミスを発見しずらくなります。 面倒でもインデント(TAB)はきれいに整えましょう。 5.処理中にRange.Selectは使わないこと。 下記のコードを見て分かるように、正しく書けばSelectは必要ありません。 もしアクティブブック・シートが切り替わった状態でSelectするとエラーの原因となりますので、どうしても使うときはブックやシートもActiveにしましょう。 マクロの最後に、マクロ実行後に選択していてほしい箇所をSelectするような目的で使うのが正しい使い方です。 とはいえ、デバッグのときは処理工程でSelectしてくれたほうが、わかりやすくて便利なので一応コメントで残しています。 できるだけ構造を変えないように修正したものがこちらです。 一応ローカル環境でデバッグしたので動くと思いますが、ご自分でも良くデバッグしてください。 ``` Sub 転記() Dim wB As Workbook, wS As Worksheet Dim myPath As String, fN As String Dim x As Long '1A入力用(転記元)の"D1"を参照し、B共有フォルダの「管理状況」にある '集約管理(転記先)のブックを開く myPath = "共有サーバー\管理状況\" fN = "【共有】集約管理" & Range("D1").Value & "月" & ".xlsx" 'ローカルテスト用 'myPath = "C:\tmp\" 'fN = "管理用B.xlsx" '既にfNを開いていたら閉じる On Error Resume Next Set wB = Workbooks(fN) On Error GoTo 0 If Not wB Is Nothing Then wB.Close False End If Application.DisplayAlerts = False Set wB = Workbooks.Open(Filename:=myPath & fN, Notify:=False) Application.DisplayAlerts = True If wB.ReadOnly Then MsgBox "他の人が作業中です。しばらく経ってから転記し直してください。" wB.Close False Exit Sub Else Set wS = wB.Sheets("list") wB.Activate '←普通は必要ないが、一応。 wS.Activate wS.Range("A1") = Now End If '2A入力用(転記元)のB列「*」の一つ下のC列からM列までをコピー With ThisWorkbook.Worksheets("入力フォーム") x = 4 Do While .Cells(x, 3).Value <> "" If .Cells(x, 2).Value <> "*" Then .Cells(x, 2).Value = "*" '----コピーと同時にB列へ転記すみ「*」を追記 .Range(.Cells(x, 3), .Cells(x, 13)).Copy '3共有フォルダの「管理状況」にある集約管理へ転記 '----B列の最終ひとつ下を選択してから値として貼り付け With wS.Cells(wS.Rows.Count, 2).End(xlUp).Offset(1, 0) 'wB.Activate '←Selectを使いたいときはコレも書いたほうが安全 'wS.Select '←Selectをry '.Select '←省略可 .PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False End With End If x = x + 1 Loop End With Application.CutCopyMode = False 'データの末尾の次の行を選択 wB.Activate wS.Select wS.Cells(wS.Rows.Count, 2).End(xlUp).Offset(1, 0).Select Application.DisplayAlerts = False wB.Save Application.DisplayAlerts = True wB.Close False '----元のファイルを保存し閉じる MsgBox "転記しました。" Workbooks.Open Filename:=myPath & fN, ReadOnly:=True '----読み取り専用で開く End Sub ``` 尚、本件はこのように1行づつコピー&貼り付けでも問題ないと思いますが、大量のデータを処理する場合は以下のような修正が必要です。 1.先に更新する行数を求めてから複数行をまとめて処理する。 2.コピー&ペーストではなく値の直接転写を行う。