『エラー処理の仕方』（ブルークロス） よろしくお願いします。 売上と言うフォルダに1月.xlsx〜12月.xlsxがあります。 データはどれも同じような体裁で、Sheet1に下記のようなデータが入っています。 月ごとに内容や行数は変わりますが、列数は増えません。 A　　　　B　　　C 1　送付先 品名 金額 2　山梨県 りんご 30,000 3　山梨県 いちご 250,000 4　長野県 バナナ 7,500 5　新潟県 りんご 45,000 6　栃木県 バナナ 15,110 7　千葉県 りんご 28,003 8　千葉県 いちご 314,919 9　千葉県 なし -14,194 10　埼玉県 りんご 138,830 11　埼玉県 いちご 109,468 12　神奈川県 なし 6,052,267 13　神奈川県 りんご -256,597 14　東京都 なし 230,040 15　東京都 りんご 23,667 16　東京都 バナナ 4,839 17　東京都 りんご 286,840 18　東京都 いちご 3,594 同じフォルダ内の、まとめ.xlsmにはマクロの記録から、ネットで検索して継ぎ接ぎのように足したコードがあります。 任意のファイルから送付先か品名を抽出させて、最終行の下に貼り付けるものです。 Sub 月ごとの抽出() Dim OpenFileName As String Dim sai As Integer Dim lio As String Dim n As String OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls*") If OpenFileName <> "False" Then Workbooks.Open OpenFileName End If sai = InputBox("何行目を抽出しますか") lio = InputBox("抽出したい現場名か支払先") Application.ScreenUpdating = False Selection.AutoFilter ActiveSheet.Range("A1:E200").AutoFilter Field:=sai, Criteria1:=lio Range("A2:E200").Select Selection.Copy ThisWorkbook.Activate ActiveSheet.Paste n = Cells(Rows.Count, "A").End(xlUp).Row + 1 Range("A" & n).Select ActiveWindow.ActivateNext Application.CutCopyMode = False Selection.AutoFilter Range("A1").Select ActiveWorkbook.Save ActiveWindow.Close Application.ScreenUpdating = True End Sub これで何とか動いていますが、インプットボックスに何も入れないとエラーが出ます。 何も入れない場合やキャンセルを押した時に、開いたファイルをそのまま閉じて終了する方法があるか教えていただけませんでしょうか。 ＜ 使用 Excel：Excel2013、使用 OS：Windows7 ＞ ---- 例えば、こんな感じで対応すると良いでしょう。 ついでに、開いたブックをwbという変数に入れてしまえば、以降の処理はアクティブなものを対象とせず、wbを対象とするように書き換えることができますよ。 Sub test() Dim wb As Workbook Dim sai As Variant OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls*") If OpenFileName <> "False" Then Set wb = Workbooks.Open(OpenFileName) End If sai = InputBox("何行目を抽出しますか") If sai = "" Then wb.Close False Exit Sub Else sai = Val(sai) End If '---ここはブックを開いた後の処理等 wb.Close False End Sub または、ブックを開くより前に、行やその他の入力をさせてしまえば、中断用closeが不要になりますよ。 （???） 2018/10/12(金) 15:44 ---- ???さん ありがとうございます。 開いたブックを変数に入れるのは思いつかなかったです。 大変勉強になりました。 感謝いたします。 （ブルークロス） 2018/10/12(金) 16:20 ---- ＞開いたブックを変数に入れるのは思いつかなかったです。 関連する話になりますが、ざっと流し読みをした限りでは、ずっと開いたブックそのものを対象とした処理のようですから、Withステートメントを使ってやれば、もうちょい簡単に記述できるとおもいます。 また、 Selection.AutoFilter ActiveSheet.Range("A1:E200").AutoFilter Field:=sai, Criteria1:=lio ここって想定通りうごいてるのかちょっと心配です。 たぶん、上の行で「アクティブシート」のオートフィルタを”解除”して 下の行で「アクティブシート」の"A1:E200"セルにオートフィルタを設定してるんですよね？ （もこな２） 2018/10/12(金) 16:35 ---- もこな２さん ありがとうございます。 ActiveSheet.Range("A1:E200").AutoFilter Field:=sai, Criteria1:=lio ここの部分に関しては、マクロの記録にネットで調べたものを書き換えています。 それでなんとか動いてる状況です。 あまり上手くない動きなのかも知れません。 （ブルークロス） 2018/10/12(金) 17:04 ---- 運用でうまく対応できてるなら別にいいとおもいますけど、 Selection.AutoFilter ctiveSheet.Range("A1:E200").AutoFilter 1行目の記述ですと、 （開いたブック）の（アクティブシート）の「選択されているセル」に「オートフィルタ」を設定/解除になります。 ※「選択されているセル」が単一セルだったときは、当該を含む表範囲と解釈される。 ですので、目的のブックを開いた時に 　対象となるシートがアクティブだった場合 　　オートフィルタが設定されている場合 　　　　オートフィルタを解除して、「A1:E200」にオートフィルタを設定　→　成功 　　オートフィルタが設定されておらず、「A1:E200」のいずれかの単一セルが選択されている場合 　　　　A1:E200にオートフィルタを設定　→　成功 　　オートフィルタが設定されておらず、「A1:E200」の一部のみが選択されている場合 　　　　選択されている範囲のみにオートフィルタを設定　→　失敗 　　オートフィルタが設定されておらず、「A1:E200」以外の単一セルあるいはセル範囲が選択されている場合 　　　　エラーになるか目的じゃない場所にオートフィルタが設定される　→　失敗 　対象となるシート以外がアクティブだった場合 　　　　目的シート以外でオートフィルタの操作をすることになる　→　失敗 という点が心配です。 （もこな２） 2018/10/13(土) 15:24 ---- （続き） 気になる点としては上記の通りですが、 そもそも論として >＞売上と言うフォルダに1月.xlsx〜12月.xlsxがあります。 なので、ブックごとにオートフィルタ＆コピーをするのではなく、一度集約用のシートに全データをコピーしてきて、そこから抽出するようにしてみてはどうでしょうか。 オートフィルタの部分はさておき、同じフォルダに「1月.xlsx〜12月.xlsx」が保存されていて、かつの対象となるシートが1番目のシートで固定されているなどであれば、集約ブックに集めるのはそう難しい話でもないと思います。 適当に組んでテストしてないですけど、↓みたいに項目行を含めないで集約用のシートに累積されるようコピーしていけばいいですよね。 Sub サンプル() Dim i As Long, ふらぐ As Long Dim dstSH As Worksheet: Set dstSH = ThisWorkbook.Worksheets("集約用") Dim srcRNG As Range, dstRNG As Range dstSH.Cells.Delete dstSH.Range("A1").Value = "由来ブック名" Set dstRNG = dstSH.Range("B1") For i = 1 To 12 Step 1 With Workbooks.Open("D:\WORK\売上\" & i & "月.xlsx").Worksheets(1) Set srcRNG = Intersect(.UsedRange, .UsedRange.Offset(ふらぐ)) If Not srcRNG Is Nothing Then srcRNG.Copy dstRNG dstRNG.Offset(, -1).Resize(srcRNG.Rows.Count).Value = .Parent.Name Intersect(.UsedRange, .UsedRange.Offset(ふらぐ)).Copy _ dstSH.Cells(dstSH.Rows.Count, "A").End(xlUp).Offset(1) ふらぐ = 1 Set dstRNG = dstSH.Cells(dstSH.Rows.Count, "B").End(xlUp) .Parent.Close End If End With Next i End Sub （もこな２） 2018/10/13(土) 18:41 ---- もこな2さん ありがとうございます。 ファイルを家のPCでやってみたところ、1月.xlsxは52行ほどしか無いにも関わらず、 A列に1月.xlsxと言うファイル名がそのままズラッと2031行まで書かれており、2032行目に同じ1月のデータが貼られてしまいました。 12月ファイルまでその繰り返しになってしまいました・・・。 やり方が悪かったのかも知れません。 しかしながら、他にも方法があると教えて頂きありがとうございました。 （ブルークロス） 2018/10/14(日) 23:15 ---- 失礼。いろいろミスってますね。 こちらでステップ実行しながら試してみてください。 Sub サンプル弐() Dim i As Long, ふらぐ As Boolean Dim dstSH As Worksheet: Set dstSH = ThisWorkbook.Worksheets("集約用") Dim srcRNG As Range, dstRNG As Range Dim sai As Integer, lio As String Stop '集約シートのクリア等 dstSH.Cells.Delete dstSH.Range("A1").Value = "由来ブック名" '集約用のシートにデータを集める処理 For i = 1 To 12 Step 1 With Workbooks.Open("D:\WORK\売上\" & i & "月.xlsx").Worksheets(1) '1回目の時だけ項目行をコピー If Not ふらぐ Then .UsedRange.Rows(1).Copy dstSH.Range("B1") ふらぐ = True End If '項目行以外を「srcRNG」に格納 Set srcRNG = Intersect(.UsedRange, .UsedRange.Offset(1)) '「srcRNG」に格納されたものがあれば(Nothing以外が格納されていれば)コピペ等を実行 If Not srcRNG Is Nothing Then Set dstRNG = dstSH.Cells(dstSH.Rows.Count, "B").End(xlUp).Offset(1) srcRNG.Copy dstRNG dstRNG.Offset(, -1).Resize(srcRNG.Rows.Count).Value = .Parent.Name End If .Parent.Close End With Next i ' ' '集約用のシートにオートフィルタをかける処理 sai = InputBox("左から何【列】目を抽出しますか") lio = InputBox("抽出したい現場名か支払先") With ThisWorkbook.Worksheets("出力用") '←抽出結果を貼付けたいシートに適宜変更 '↓このようにすれば、オートフィルタの状態にかかわらず必ず解除される dstSH.AutoFilterMode = False '↓こうすればExcel君の方で「そのセルが含まれる表範囲」と解釈してオートフィルタフィルタを設定してくれる dstSH.Range("A1").AutoFilter Field:=sai, Criteria1:=lio dstSH.Range("A1").CurrentRegion.Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1) End With End Sub （もこな２） 2018/10/15(月) 01:07 ---- もこな２さん 深夜に申し訳ありません。 実はあの切り貼りマクロでデータを抽出し、何とか動いて良かった良かった…と思っていたのですが…。 何月のファイルか分からないな…とも思っていました。 これなら、ファイル名も入るので一目瞭然で感動いたしました。 細かにコメントも付けていただき、勉強になります。 午前中バタバタして、お礼が遅れて申し訳ありません。 今回は本当にありがとうございました。 （ブルークロス） 2018/10/15(月) 16:20