フォルダー内の全てのブックを順に開いて共通セル範囲をコピー貼り付けするには?
Question 5313 拙著「Excel VBA そのまま使える実用マクロ 500連発」 Previous Next
詳細は こちら サンプルNo.498 ◆ 環境・・ Excel 2003 & Windows XP

「フォルダー内の全てのブックを順に開く」で、「
(ここで必要な処理を行う) 」 という場所に色々試して作っても、どうも上手く出来ず、どうしていいか困っております。宜しくお願い致します。
私がしたい事
・ファイル名が「○○基本計画表」とか「▲▲基本計画表」と複数あり随時増えていく
・別のフォルダーのシートにコピーしたい

補足しますと、「AA」フォルダ内、「○○基本計画表.xls」の一番左側シートのB1:C61をコピーし、貼付先は「BB」フォルダー内、「基本計画一覧.xls」の「Sheet1」のA2に行列を変更して貼り付け、同じ様にE1:F61を行列を変更してBJ2に貼り付けたいです。
その次は「▲▲基本計画表.xls」からコピー (セル範囲は共通) して 4・5行目に貼り付け、以後同様です。
Answer   Copyright (C) 2009.11.19 永井善王
拙著「Excel VBA そのまま使える実用マクロ 500連発」をご購読、ありがとうございます。
ご質問は、本の352ページにある下記部分の活用についてですね。
1. With ThisWorkbook.Worksheets("Sheet2")

  下端行 = .Range("A" & Rows.Count).End(xlUp).Row
  For カウンタ = 1 To 下端行
    ブック名 = .Range("B" & カウンタ).Value
     開くフォルダーパス = .Range("A" & カウンタ).Value
    フルパス = 開くフォルダーパス & ブック名
    Workbooks.Open Filename:=フルパス, Editable:=True
    ActiveWorkbook.Close SaveChanges:=False
  Next
End With
        |  
(ここで必要な処理を行う)

'(このシートに開くべきブックの
'名前とフォルダーパスが入っている)


'ブック名を取得する
'フォルダーパスを取得する

'ブックを開く(マクロ無効で)
'ブックを閉じる




500-3-498 CD-ROM 「色々試して作っても、どうも上手く出来ず」ということで、お手数を掛けてしまいましたね。
さっそく調べてみましたところ思いがけないミスプリントを発見しましたので、訂正させてください。

あなたが当てにされた「
(ここで必要な処理を行う)」は本の352ページかと思いますが、これは行ズレしています。
正しい位置は、付属CD-ROMのサンプルブック「498.xls」にある右図のとおりになります。

あなたがご苦労されたのは、おそらく、このせいではないかと、お詫び申し上げます。

よって、この正しい位置にコピー貼り付けのコードを追加していただけば、ブックの名前が 「○○・・.xls」 とか
「▲▲・・.xls」 とかであったとしても、選択したフォルダーの中にあるならば処理されることになります。
注意点は下記2点でしょう。
 ・ブックを開いたときに、 「一番左側シート」 が必ずアクティブになるとはいえないので、それへの対策
 ・貼り付ける行を2行間隔で順次調節する
なお、「行列を変更して貼り付け」のコードはマクロ記録してみれば分かるので例示の必要はないかもしれませんが、下記に一例としてあげておきます。 (コピー範囲は B1:C6 だけとし、マクロは「基本計画一覧.xls」に作成 … 前もって開いてある前提)
    Worksheets(1).Select                        '1番左側のワークシート    
    Range("B1:C6").Select
    Selection.Copy
    Windows("基本計画一覧表.xls").Activate
    Sheets("Sheet1").Select
    貼付行 = 貼付行 + 2
    Range("A" & 貼付行).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
では、うまく仕上がったらご一報ください。お待ちしています。

※どうしても出来ない場合は、貴方の作成したマクロの入ったブックを Eメールに添付してお送りください。
Eメールアドレスがわからない場合は、下記ページを参照してください。
http://www.asahi-net.or.jp/~zn3y-ngi/YNxv5.html
Question      
ご回答有難う御座います。
色々、ご迷惑をお掛けして申し訳ありませんが、ご指示通りにしたつもりですが、やはりうまくいきませんでした。
旨く出来なかった点としましては、貼り付ける先が閉じられてしまうので、つぎつぎに続きません。
多分、最後のウィンドが 「基本計画一覧表.xls」 になって、
ActiveWorkbook.Close SaveChanges:=False  するからでしょうか??
本当に色々お手数をお掛けしますが、宜しお願い致します。
Answer    
あなたのおっしゃるとおりですね。 よって、
ActiveWorkbook.Close SaveChanges:=False '閉じる  を  Workbooks(ブック名).Close SaveChanges:=False '閉じる
に修正されれば解決すると思います。 ついでに、その直前に下記コードを追加されることをお勧めします。
Application.CutCopyMode = False
では、成功を祈ります。
ありがとうございました
本当に助かりました。本当に有難う御座いました。又、今後とも宜しく御願いいたします。
★正直にこの様に本の著者の方からアト゛ハ゛イスを頂けるとは思ってもいなくスゴ━━━(*゜∀゜*)━━━イ感動でした。
余りの感動に全体会議の時に一言発表する機会があり、何を話すかいつも迷うのですが、今回の一連の感動を発表さ せて頂きこの様な細かなフォローをして頂ける事に皆もびっくりしたました。゜+。゜★感・・(ノ)゜∀゜(ヾ)・・激★゜。+゜

Excel VBA Macro