VBA フォルダ内の特定ブック内のシートを特定し、それらのセルの値を全て1つにまとめる

質問

はじめまして。
excel2000ですが・・・

以下の過去ログと類似しているのですが、
http://oshiete1.goo.ne.jp/qa4134321.html

管理表.xlsと同一フォルダ内に、
予定表1.xls　（sheet1,　sheet予定1,　sheet予定2,　sheet2)
予定表2.xls　（sheet1,　sheet予定2,　sheet予定3,　sheet2)
予定表3.xls　（sheet1,　sheet2,　sheet予定1,　sheet予定5)
予定表4.xls　（sheet1,　sheet予定4,　sheet予定2,　sheet2)
予定表5.xls　（sheet予定2,　sheet予定1,　sheet1,　sheet2)
・
・
・
（管理表.xlsもあります）

が、あるとします。
フォルダ内の全ての「予定表*.xls」ブックの中の「sheet予定*」シートの一定の範囲の値を「管理表.xls」の「sheet1」にまとめたいと思っています。
ここでやっかいなのが、「sheet予定*」は、同一のフォーマットなので、まとめやすいと思ったのですが、セルが結合されていたり、マクロが入っていたりで、なかなか思うようにペーストできません。必要なのは値だけなので、「Sheet予定*」の一定範囲(B4:I4、B5:I5、B6:I6・・・)の値を「管理表.xls」の「sheet1」のそれぞれ1行ずつ（例えばA4:H4、A5:H5・・・）にまとめていきたいです（コピペではなく参照の方がよいのでしょうか）。

自分でやろうとして色々調べながらできたのは、フォルダ内のファイル名「予定表*.xls」の取得のみです。「sheet予定*」の値の参照もやってみましたが、上書きされ、結局最後にコピーした「sheet*」予定のセルの範囲のみが貼り付けられて終わってしまいました。

長々と書いてしまって申し訳ありませんが、わかる方いらっしゃいましたら、ご指導いただきたいと思います。

回答No.4

n-jun · ベストアンサー

ブックのループは出来るとして、それ以外についてのサンプル。

１つのブックをコピーします。
Sheet2はデータのない状態にしておいて下さい。
以下のコードを貼り付けます。

Sub　test()
　Dim　ws　As　Worksheet
　Dim　r　As　Range
　Dim　v,　i　As　Integer

　v　=　Array("J3",　"O3",　"G3",　"H3")

　Set　r　=　Worksheets("Sheet2").Range("A1")

　For　Each　ws　In　Worksheets
　　　　　If　InStr(ws.Name,　"予定")　Then
　　　　　　　　With　ws
　　　　　　　　　　　　　For　i　=　0　To　3
　　　　　　　　　　　　　　　　　r.Offset(,　i).Value　=　.Range(v(i)).Value
　　　　　　　　　　　　　Next
　　　　　　　　　　　　　r.Offset(1).Resize(32,　17).Value　=　.Range("B14:R45").Value
　　　　　　　　　　　　　Set　r　=　r.End(xlDown).Offset(1)
　　　　　　　　End　With
　　　　　End　If
　Next
　Set　r　=　Nothing
End　Sub
シート名に”予定”が含まれていると、そのシートのデータをSheet2に
代入していきます。
シートが変われば順次Sheet2に続けて代入します。

ご参考になれば。

お礼

どうもありがとうございます！
なんか動きました！
ですが、1つ目のファイルは問題なく終わるのですが、2つ目のファイルに行ってから
r.Offset(, i).Value = .Range(v(i)).Valueで止まってしまいます。

実行時エラー'91':
オブジェクト変数またはWithブロック変数が設定されていません。

と、表示されてしまいます。

それと「シート予定*」の他に「シート予定*記入例」みたいなシートが隠れておりまして、そのシートまで拾われてしまいます。でもこれに関してはファイルの検索でも使っていたことだし、ワイルドカードでも使って対応してみようと思います。

丁寧に教えていただきありがとうございます。
助かります！

回答No.5

n-jun

ANo.4です。

>ですが、1つ目のファイルは問題なく終わるのですが、2つ目のファイルに行ってから
>r.Offset(, i).Value = .Range(v(i)).Valueで止まってしまいます。
ブックのループは一切考慮していませんので、エラーになりますね。

例えば、
Set　r　=　Worksheets("Sheet2").Range("A1")
は
Set　r　=　ThisWorkbook.Worksheets("Sheet2").Range("A1")
とかブックを指定しなければなりません。

また
For　Each　ws　In　Worksheets
でも、どのブックのワークシート群なのかを指定しなければなりません。

基本的にサンプルですので、あとはどのように変更してエラーになったのかは、
エラーの発生した文とエラー内容のみではわからない時もあります。
全体のコードの提示が必要かと。
（提示したサンプルそのままでエラーになった場合なら、回答者側でも
　検証は出来ますけど）

お礼

たびたびご迷惑をおかけしております。
本当に助かります！ありがとうございます！
Set r = Nothingを消したらフォルダ内の検索はうまくいきました！
また、シート名の検索も
If Instr(ws.Name, "予定")Then
から
If ws.Name Like "*予定")Then
に変更し、問題ないと思います。

ただ、ひとつだけ問題があり、sheet予定2のシートだけが、B45～R45のデータが取れないのです。おそらくsheet予定2のB43～R43が空白だからカウントされないんだと思うのですが。もう少し調べてみます！

回答No.3

CaveatEmptor

他の方の回答にあるように、マクロが入っていることは関係ないと思います。

セルの結合が原因でコピペができないのであれば、マクロでセルの結合を解除してコピペすれべいいのではないでしょうか？（開いたファイルを上書き保存せずに閉じれば、元データは変更されません）もしくは、行全体をコピペするという手もあると思いますが、ダメでしょうか？

お礼

回答ありがとうございます。
結合を解除してコピペですか。
ということは書式等も初期値にしたほうがよいのでしょうか。
結局欲しいのは値だけなので、書式は関係ないでしょうか。
少し調べてみます。
どうもありがとうございます！

回答No.2

n-jun

コピペより代入の方がよかったりするかも？

>セルが結合されていたり
どこがどのように結合されてるか見えないのでなんとも。。。

お礼

回答いただきありがとうございます。
私も代入の方がいいと思うのですが、配列というのがどうも理解できなくて・・・。
フォルダ内のファイルを検索して順番にファイルを開いていったり、該当シートをアクティブにしたりすることは何とかできたのですが、コピー、しかも限られた範囲のみというのが思うようにできません。最初はシートを管理表.xlsの空白のシートに丸々コピーしようと思ったのですが、セルが結合されていて貼り付けられなかったり、条件を変えてやってみたのですが、シート毎コピーするのはできたのですが、その次に開いたシートをコピーして、前にコピーした上に上書きみたいな状態になってしまい、先に進みません。
最終的には必要データのみを抜きたいので、シートごとのコピーはなるべく避けたいと思います。

「sheet予定*」は全て同一のフォーマットで、結合されていて値を抜き出したいセルは

・予定表1.xlsから始まると仮定して

sheet予定1を選択し・・・
「J3(J3:M3の結合)」、「O3(O3:Q3の結合)」の2箇所で、その2箇所プラス「G3」と「H3（値が"*月度"となっているので、月度を抜いて"*"だけにしたい）」の合計4項目の値を管理表のsheet1の1行目(A1～D4)に、
あとは、B14～R14の値を「管理表Sheet1の2行目(A2～Q2)へ
　　　 B15～R15の値を「管理表sheet1の3行目(A3～Q3)へ
B16～R16の値を「管理表sheet1の4行目へ(A4～Q4)へ
　　　　　　　　　　　・
　　　　　　　　　　　・
　　　　　　　　　　　・
B45～R45の値を「管理表sheet1の33行目へ(A33～Q33)

sheet予定2を選択し・・・
「J3(J3:M3の結合)」、「O3(O3:Q3の結合)」の2箇所と、「G3」と「H3（同じく"月度"を抜く）」の合計4項目の値を管理表のsheet1の34行目(A34～D34)に、
あとは、B14～R14の値を「管理表Sheet1の35行目(A35～Q35)へ
　　　 B15～R15の値を「管理表sheet1の36行目(A36～Q36)へ
B16～R16の値を「管理表sheet1の37行目へ(A37～Q37)へ

　　　　　 　 　　 　 ・
　　　　　　　　　　　・
　　　　　　　　　　　・
B45～R45の値を「管理表sheet1の67行目へ(A67～Q67)

sheet予定*がなくなるので予定表1.xlsを閉じる

予定表2.xlsを開く・・・

という感じで行いたいのです。
わがままなお願いかもしれませんが、よろしくお願いします。

回答No.1

spnlight

(1)管理表.xlsにすべての予定表*.xlsをリンク貼付けするとか、（予定表1.xlsのsheet予定1のB4:I4、B5:I5、B6:I6・・・を管理表.xlsのsheet1のA4:H4、A5:H5・・・にリンク張付け→sheet予定2のB4:I4、B5:I5、B6:I6・・・をA10:H10、A11:H11・・・にリンク張付け）

(2)マクロで1予定表毎にファイルオープンして、データを自動でコピペするとか

>結局最後にコピーした「sheet*」予定のセルの範囲のみが貼り付けられて終わってしまいました
コピー→張付け→コピー→張付け・・・で出来ませんか？

>セルが結合されていたり、マクロが入っていたりで
どちらも影響が無いような気がするけど・・・現物見れないんで分かりませんねー

お礼

回答いただきありがとうございます。
VBAを使って、使い勝手のよいレイアウトにしようと思ってるので、リンクではなく、コマンドボタンなどで行うと思います。