[[20080905162923]]　『フォルダー内のブックを1つのまとめたい』（ＫＵＮ）　ページの最後に飛ぶ

『フォルダー内のブックを1つのまとめたい』（ＫＵＮ）

 教えてください。こんな事ってできますか？
　
 報告用のEXCELが各支店（132店舗）から集まってきます。（メールにて）
このEXCELは全店舗同一のシートでデータは30行（見出し含む）しかありません。
シート名は「報告書」で統一されていますが、ブック名はいろんな名前で飛んできます。
毎日、集めたEXCELはフォルダーにまとめています。
このフォルダー内のEXCELデータの全てを1っのデータにしたいのですが・・・
こんな事って可能ですか？

 （例）報告用ＥＸＣＥＬ

 　　　　　　　　　　営業日報

  店　　　営業部員　　目標　　実績　　・・・・　　繰越
 東京支店　田中一郎　　　15　　　5　　　　　　　　　　1
 東京支店　山田太郎　　　12　　　1　　　　　　　　　　2
 東京支店　鈴木次郎　　　10　　　3　　　　　　　　　　4

 東京支店　計　　　　　1520　　245　　　　　　　　　300

  まとめたいＥＸＣＥＬ

  店　　　営業部員　　目標　　実績　　・・・・　　繰越
 東京支店　田中一郎　　　15　　　5　　　　　　　　　　1
 東京支店　山田太郎　　　12　　　1　　　　　　　　　　2
 東京支店　鈴木次郎　　　10　　　3　　　　　　　　　　4
 東京支店　計　　　　　1520　　245　　　　　　　　　300　 
 青山支店　岡田一郎　　　10　　　4　　　　　　　　　　20
 青山支店　加藤純一　　　20　　　4　　　　　　　　　　22
 東京支店　計　　　　　　520　　120　　　　　　　　　34　
 京都支店　横山正巳　　　15　　　2　　　　　　　　　　1
 京都支店　計　　　　　　320　　201　　　　　　　　　54　
　
　毎日、イラツキながらコピペを繰りています。
　ど～か、教えてください。

　お願いいたします。

 多分これの応用で出来ると思います。
[[20080711151902]]『エクセルファイルに他のエクセルファイルのシートから目的の行を読み込みたい』（事務作業が進まない子）

 （川野鮎太郎）

 参考：http://hp.vector.co.jp/authors/VA033788/kowaza.html#0016
 余分な行は、並べ替えてまとめて削除。その前に作業列に連番を振っておき、後で元に戻す。

 もしシート名が共通で、なおかつ範囲が決まっているのならいちいち開かなくてもよいでしょう。
 シート名はSheet1ということで想定しています。

 Sub test()
 Dim myDir As String , fn As String, myAddress As String
 Dim LastR As RAnge, flg As Boolean, adrs As String
 myDir = "c:\temp"   '<- フォルダパス
 myAddress = "A1:Z30"  '<- 範囲
 With Range(myAddress)
     RowCount = .Rows.Count
     ColumnCount = .Columns.Count  '<- ここ
     adrs = .Cells(1,1).Address
 End With
 fn = Dir(myDir & "\*.xls")
 If fn = "" Then Exit Sub
 With Thisworkbook.Sheets(1)
     .Cells.Delete
     Do While fn <> ""
         If Not flg Then
             Set LastR = .Range("a1")
             flg = True
         Else
             Set LastR = .Range("a" & Rows.Count).End(xlUp)(2)
         End If
         With LastR.Resize(RowCount, ColumnCount)
             .Formula = "='" & myDir & "\[" & fn & "]sheet1'!" & _
                 Range(adrs).Offset(IIf(flg,1,0)).Address(0,0)
             .Value = .Value
         End With
         fn = Dir
     Loop
 End With
 End Sub
 (seiya)

 seiya様、川野鮎太郎様　ありがとうございます。
 seiya様　のマクロを自分なりに解読してみたのですが、エラーが出てしまったので再度教えてください。
 また、データの貼り付け時、値で貼り付けを行いたいのですが何処を修正すればよいのでしょうか？
 copyという命令がないので、お手上げです。
 お手数をおかけいたしますが、宜しくお願いいたします。

 エラー箇所は・・・
 With LastR.Resize(RowCount, ColumnCount)　　で

 LastR.Resize＝アプリケーション定義又はオブジェクトの定義エラー
 RowCount=30
 ColumnCount=emtpy値　と表示されます。

 (kun)

 すみません　タイプミスです

      ColCount = .Columns.Count
      ^^^
      ColumnCount = .Columns.Count
 です
 (seiya)

 seiya様、早速の回答ありがとうございます。

 エラーが回避されました。

 コピーも値でされていました。ありがとうございました。

 ところで、もう1っおしえてください。

 送られてくるデータはシートが3つあり、そのうちの「日報」というシートを
 集約したいのですが、シート名を指定する方法を教えてください。

 本当に申し訳ありませんが、どうか宜しくお願いいたします。
 （kun）

 ＞.Formula = "='" & myDir & "\[" & fn & "]sheet1'!" & _
 を
 .Formula = "='" & myDir & "\[" & fn & "]日報'!" & _
 に変更するだけではだめですか。

 （川野鮎太郎）

 川野鮎太郎さん、フォローどうもです。
 その変更でいけるはずです。

 それとも、変数を使用？

 Dim wsName  '<- 追加
 wsName = "日報"　　　'<- 追加

 .Formula = "='" & myDir & "\[" & fn & "]" & wsName & "'!" & _
 変更
 (seiya)

コメント返信：

[ 一覧(最新更新順) ]

[[20080905162923]] 『フォルダー内のブックを1つのまとめたい』（ＫＵＮ） ページの最後に飛ぶ

[[20080905162923]]　『フォルダー内のブックを1つのまとめたい』（ＫＵＮ）　ページの最後に飛ぶ